home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173bbas.zip / RBBSSUB4.BAS < prev    next >
BASIC Source File  |  1990-10-28  |  130KB  |  3,380 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB4.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack'  ' DA081003
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB4.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AnyBut         59760  Determine where a "word" begins
  18. '  AskUsers       64003  Ask users questions based on a script and save answers
  19. '  AskMore        59858  Check whether screen full
  20. '  AutoPage       60300  Check whether to notify sysop caller is on
  21. ' BadFileChar     59800  Check file name for bad character
  22. '  Bracket        59960  Puts strings around a substring
  23. '  BufFile        58400  Write a file to the user quickly
  24. '  BufString      58300  Write a string with imbedded CR/LF to the user quickly
  25. '  CheckColor     59930  Highlighting based on search string
  26. '  SearchArray    58190  Check for the occurance of a string in an array
  27. '  ColorDir       59920  Adds colorization to FMS directory entry
  28. '  ColorPrompt    59940  Colorizes prompts
  29. '  CompDate       59880+ Produces a computational data from YY, MM, DD
  30. '  ConfMail       59854  Check conference mail waiting
  31. '  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
  32. '  PackDate       59201  Compress date in string format to 2 characters
  33. '  EofComm        60000  Determine whether any chars in comm port buffer
  34. '  ExpireDate     59890  Calculate registration expiration date
  35. '  FakeXRpt       62650  Write out file transfer report for protocols that don't
  36. '  FindEnd        58770  Find where a "word" ends
  37. '  FindFile       58790  Determine whether a file exists without opening it
  38. '  FindLast       58600  Find last occurence of a string
  39. '  FMS            58200  Search the upload management system for entries
  40. '  GetAll         59780  Get list of all directories to display
  41. '  GetDirs        58895  Prompts for directories for file list/new/search cmds
  42. '  GetMsgAttr     62530  Restore attributes of original message
  43. '  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
  44. '  GlobalSrchRepl 60100  Global search and replace
  45. '  LogPDown       59400  Records download in private directory
  46. '  MarkTime       60200  Give visual feedback during lengthy process
  47. '  MetaGSR        60130  Meta statement global search and replace
  48. '  MsgImport      59698  Allow local user to import a text file to a message
  49. '  Muzak          59100  Play musical themes for different RBBS functions
  50. '  NewPassword    60668  Get a new password
  51. '  PersFile       59300  View and select personal files for downloading
  52. '  Protocol       62600  Determine if external protocols are available
  53. '  PutMsgAttr     62520  Save attributes of original message
  54. '  Remove         58210  Remove characters from within strings
  55. '  RotorsDir      58700  Searches for a file using list of subdirs
  56. '  RptTime        62540  Report date/time and time on
  57. '  SetEcho        59600  Set RBBS properly for who is to echo
  58. '  SetHiLite      59934  Set user preference on highlighting
  59. '  SetGraphic     59980  Sets graphic preference for text file display
  60. '  SmartText      58250  Process SMART TEXT control strings
  61. '  SubMenu        59500  Processes options that have sub-menus
  62. '  TimedOut       63000  Write timed exit semaphore file
  63. '  TimeLock       60180  Check for TIME LOCK on certain features
  64. '  Transfer       62624  RBBS-PC support for external protocols for file transfer
  65. '  Toggle         57000  Toggles or views user options
  66. ' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
  67. '  UnPackDate     59902  Uncompresses a 2 byte date
  68. '  UserColor      59965  Lets user set color for text and whether bold
  69. '  UserFace       59450  Processes programmable user interface
  70. '  ViewArc        64600  Display .ARC file contents to user
  71. '  PrivDoorRtn    62629  Private door exit routine
  72. '  WipeLine       58800  Wipes away a line so next prints in its place
  73. '  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
  74. '
  75. '  $INCLUDE: 'RBBS-VAR.BAS'
  76. '
  77. 57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences'
  78. ' $PAGE
  79. '
  80. '  NAME    -- Toggle
  81. '
  82. '  INPUTS  -- ToggleOption      Option to toggle or view
  83. '                               according to the following:
  84. '    ToggleOption         PREFERENCE
  85. '   Toggle   VIEW
  86. '     1       -1           Autodownload
  87. '     2       -2           Bulletin review on logon
  88. '     3       -3           Case change
  89. '     4       -4           File review on logon
  90. '     5       -5           Highlight
  91. '     6       -6           Line feeds
  92. '     7       -7           Nulls
  93. '     8       -8           TurboKey
  94. '     9       -9           Expert
  95. '    10      -10           Bell
  96. '
  97. '  OUTPUTS -- ZSubParm   passed from TPut
  98. '
  99. '  PURPOSE -- Sets or views any single user preference value
  100. '
  101.       SUB Toggle (ToggleOption) STATIC
  102.       ZSubParm = 0
  103.       IF ToggleOption < 0 THEN _
  104.          GOTO 57005
  105.       ON ToggleOption GOSUB _
  106.          57010, _         'Autodownload
  107.          57120, _         'Bulletin review on logon
  108.          57260, _         'Case change
  109.          57150, _         'File review on logon
  110.          57040, _         'Highlight
  111.          57100, _         'Line feeds
  112.          57210, _         'Nulls
  113.          57230, _         'TurboKey
  114.          57190, _         'Expert
  115.          57170            'Bell
  116.       EXIT SUB
  117. 57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
  118.       ON -ToggleOption GOSUB _
  119.          57030, _         'Autodownload
  120.          57130, _         'Bulletin review on logon
  121.          57270, _         'Case change
  122.          57160, _         'File review on logon
  123.          57050, _         'Highlight
  124.          57110, _         'Line feeds
  125.          57220, _         'Nulls
  126.          57240, _         'TurboKey
  127.          57200, _         'Expert
  128.          57180            'Bell
  129.       EXIT SUB
  130. 57010 IF ZAutoDownDesired THEN _
  131.          GOTO 57020
  132.       IF NOT ZAutoDownVerified THEN _
  133.          CALL TestUser
  134.       IF NOT ZAutoDownYes THEN _
  135.          CALL QuickTPut1 ("Your comm pgm does not support AUTODOWNLOAD") : _
  136.          ZAutoDownDesired = ZTrue
  137. 57020 ZAutoDownDesired = NOT ZAutoDownDesired
  138. 57030 ZOutTxt$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  139.      CALL QuickTPut1 (ZOutTxt$)
  140.      RETURN
  141. 57040 IF ZEmphasizeOnDef$ = "" THEN _
  142.         CALL QuickTPut1 ("Highlighting unavailable") : _
  143.         RETURN
  144.      IF NOT ZHiLiteOff THEN _
  145.         CALL QuickTPut (ZColorReset$,0)
  146.      CALL SetHiLite (NOT ZHiLiteOff)
  147.      GOSUB 57050
  148.      CALL UserColor
  149.      RETURN
  150. 57050 IF ZEmphasizeOn$ <> "" THEN _
  151.         ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  152.         ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  153.      CALL QuickTPut1 (ZEmphasizeOn$ + "Highlighting" + ZEmphasizeOff$ + _
  154.                  " " + FNOffOn$(NOT ZHiLiteOff))
  155.      RETURN
  156. 57100 ZLineFeeds = NOT ZLineFeeds
  157.       IF ZLocalUser THEN _
  158.          ZLineFeeds = ZTrue
  159. 57110 CALL QuickTPut1 ("Line Feeds " + FNOffOn$(ZLineFeeds))
  160.       CALL SetCrLf
  161.       RETURN
  162. 57120 ZCheckBulletLogon = NOT ZCheckBulletLogon
  163. 57130 ZOutTxt$ = MID$("Skip Check",1 -5 * ZCheckBulletLogon,5) + _   ' DA071701
  164.            " old Bulletins in logon"                                 ' DA071701
  165.       CALL QuickTPut1 (ZOutTxt$)
  166.       RETURN
  167. 57150 ZSkipFilesLogon = NOT ZSkipFilesLogon
  168. 57160 ZOutTxt$ = MID$("CheckSkip",1 -5 * ZSkipFilesLogon,5) + _      ' DA071701
  169.            " new files in logon"
  170.       CALL QuickTPut1 (ZOutTxt$)
  171.       RETURN
  172. 57170 ZPromptBell = NOT ZPromptBell
  173. 57180 ZOutTxt$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  174.       CALL QuickTPut1 (ZOutTxt$)
  175.       RETURN
  176. 57190 ZExpertUser = NOT ZExpertUser
  177.       CALL SetExpert
  178. 57200 ZOutTxt$ = MID$("NoviceExpert",1 -6 * ZExpertUser,6)
  179.       CALL QuickTPut1 (ZOutTxt$)
  180.       RETURN
  181. 57210 ZNulls = NOT ZNulls
  182.       ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
  183.       CALL SetCrLf
  184. 57220 ZOutTxt$ = "Nulls " + FNOffOn$(ZNulls)
  185.       CALL QuickTPut1 (ZOutTxt$)
  186.       RETURN
  187. 57230 ZTurboKeyUser = NOT ZTurboKeyUser
  188. 57240 CALL QuickTPut1 ("TurboKey " + FNOffOn$(ZTurboKeyUser))
  189.       RETURN
  190. 57260 ZUpperCase = NOT ZUpperCase
  191. 57270 ZOutTxt$ = "UPPER CASE " + _
  192.             MID$("and lowerONLY",1 - 9 * ZUpperCase,9)
  193.       CALL QuickTPut1 (ZOutTxt$)
  194. 57280 ZUseTPut = (ZUpperCase OR ZXOnXOff)
  195.       RETURN
  196.       END SUB
  197. '
  198. 58190 ' $SUBTITLE: 'SearchArray - subroutine to check for a string in an array'
  199. ' $PAGE
  200. '
  201. '  NAME    -- SearchArray
  202. '
  203. '  INPUTS  -- PARAMETER                      MEANING
  204. '             Element$                THE STRING TO CHECK FOR
  205. '             Array$()                THE ARRAY TO BE SEARCHED
  206. '             NumEntriesToSearch      NUMBER OF ENTRIES WITHIN IN
  207. '                                     THE ARRAY TO BE SEARCHED
  208. '
  209. '  OUTPUTS -- IsInAra                 0 = STRING NOT Found IN THE
  210. '                                         ARRAY SPECIFIED
  211. '                                     OTHERWISE IT IS THE NUMBER sOF
  212. '                                     ELEMENT WITHIN THE ARRAY THAT
  213. '                                     WAS Found TO MATCH
  214. '
  215. '  PURPOSE -- Search an array for a specified string and, if found,
  216. '             return the number of the element that matched.
  217. '
  218.       SUB SearchArray (Element$,Array$(1),NumEntriesToSearch,IsInAra) STATIC
  219.       IsInAra = 1
  220.       CALL AllCaps (Element$)
  221.       MaxTries = NumEntriesToSearch + 1
  222.       Array$(MaxTries) = Element$
  223.       WHILE Array$(IsInAra) <> Element$
  224.          IsInAra = IsInAra + 1
  225.       WEND
  226.       IF IsInAra = MaxTries THEN _
  227.          IsInAra = 0
  228.       END SUB
  229. 58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
  230. ' $PAGE
  231. '
  232. '  NAME    -- FMS
  233. '
  234. '  INPUTS  -- PARAMETER                      MEANING
  235. '             DirToSearch$          RBBS-PC "DIR" CATEGORY TO LOOK
  236. '                                     FOR
  237. '             SearchString$          STRING TO SEARCH FOR
  238. '             SearchDate$            DATE TO SEARCH FOR
  239. '             ZCategoryName$()
  240. '             ZCategoryCode$()
  241. '             ZCategoryDesc$()
  242. '             CatFound
  243. '             ZNumCategories
  244. '
  245. '  OUTPUTS -- ProcessedInFMS
  246. '             DnldFlag
  247. '
  248. '  PURPOSE -- To search the file management system and display the
  249. '             files being searched for as well as the catetory descriptions
  250. '
  251.       SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
  252.                ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
  253.                ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
  254.       DnldFlag = 0
  255.       CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
  256.       ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
  257.       IF ProcessedInFMS THEN _
  258.          ZSubParm = 5 : _
  259.          GOSUB 58202 : _
  260.          ZOutTxt$ = "Scanning directory " + _
  261.               DirToSearch$ + _
  262.               SrchDir$ + _
  263.               " - " + _
  264.               ZCategoryDesc$(CatFound) : _
  265.          CALL TPut : _
  266.          Cat$ = ZCategoryCode$(CatFound) : _
  267.          CALL DispUpDir (Cat$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
  268.       EXIT SUB
  269. 58202 ZOutTxt$ = SearchDate$
  270.       IF LEN(ZOutTxt$) > 0 THEN _
  271.          ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2)
  272.       SrchDir$ = " for " + _
  273.              SearchString$ + _
  274.              ZOutTxt$
  275.       IF LEN(SrchDir$) < 6 THEN _
  276.          SrchDir$ = ""
  277.       RETURN
  278.       END SUB
  279. 58210 ' $SUBTITLE: 'Remove - subroutine to delete a string from within a string'
  280. ' $PAGE
  281. '
  282. '  NAME    -- Remove
  283. '
  284. '  INPUTS  -- PARAMETER                      MEANING
  285. '             BADSTRING$              STRING CONTAINING CHARACTERS
  286. '                                     TO BE DELETED FROM "WasL$"
  287. '             WasL$                      STRING TO BE ALTERED
  288. '
  289. '  OUTPUTS -- WasL$                      WITH THE CHARACTERS IN
  290. '                                     "BADSTRING#" DELETED FROM IT
  291. '
  292. '  PURPOSE -- To remove all instances of the characters in
  293. '                        "BADSTRING$" from "WasL$"
  294. '
  295.       SUB Remove (WasL$,BadString$) STATIC
  296.       WasJ = 0
  297.       FOR WasI=1 TO LEN(WasL$)
  298.          IF INSTR(BadString$,MID$(WasL$,WasI,1)) = 0 THEN _
  299.             WasJ = WasJ + 1 : _
  300.             MID$(WasL$,WasJ,1) = MID$(WasL$,WasI,1)
  301.       NEXT WasI
  302.       WasL$ = LEFT$(WasL$,WasJ)
  303.       END SUB
  304. '
  305. 58250 ' $SUBTITLE: 'SmartText - smart text substitution'
  306. ' $PAGE
  307. '
  308. '  NAME    -- SmartText   (WRITTEN BY DOUG AZZARITO)
  309. '
  310. '  INPUTS  -- StringWork$        string to scan for Smart Text
  311. '             CRFound            Does this line contain a CR?
  312. '             ZSmartTextCode     Smart Text control code
  313. '
  314. '  OUTPUTS -- StringWork$        Input string with Smart replaced
  315. '
  316. '  PURPOSE -- Smart Text allows control strings in text files
  317. '             to be replaced at runtime with user info or other
  318. '             data.  The Smart Text control code is a 1-byte
  319. '             code (configurable) with a 2-byte action code.
  320. '
  321.       SUB SmartText (StringWork$, CRFound, OverStrike) STATIC
  322.       IF SmartCarry$<>"" THEN _
  323.          StringWork$ = SmartCarry$+StringWork$
  324.       Index = INSTR(StringWork$, ZSmartTextCode$)
  325.       WHILE Index > 0 AND Index < LEN(StringWork$)-1
  326.          IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _
  327.             SmartAct = 0 _
  328.          ELSE _
  329.             SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2))
  330.          IF SmartAct = 0 THEN _
  331.             WasI = 1 : _
  332.             GOTO 58254
  333.          SmartAct = (SmartAct+2)/3
  334.          ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _
  335.                            58266, 58267, 58268, 58269, 58270, _
  336.                            58271, 58272, 58273, 58274, 58275, _
  337.                            58276, 58277, 58278, 58279, 58280, _
  338.                            58281, 58282, 58283, 58284, 58285, _
  339.                            58286, 58287, 58289, 58290, 58291, _
  340.                            58292, 58293, 58294
  341.          GOSUB 58256
  342.          WasI = LEN(SmartHold$)
  343.          ReplaceLen = 3
  344.          IF OverStrike OR Overlay THEN _
  345.             IF WasI > 2 THEN _
  346.                ReplaceLen = WasI _
  347.             ELSE _
  348.                SmartHold$ = SmartHold$ + SPACE$(3 - WasI)
  349.          StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _
  350.                        MID$(StringWork$,Index+ReplaceLen)
  351. 58254    Index = INSTR(Index+WasI, StringWork$, ZSmartTextCode$)
  352.       WEND
  353.       IF Index AND (Index > LEN(StringWork$)-2) AND NOT CRFound THEN _
  354.          SmartCarry$ = MID$(StringWork$,Index) : _
  355.          StringWork$ = LEFT$(StringWork$,Index-1) : _
  356.       ELSE _
  357.          SmartCarry$ = ""
  358.       EXIT SUB
  359. 58256 IF TrimSmart THEN _
  360.          CALL Trim (SmartHold$)
  361.       RETURN
  362. 58258 ZLastSmartColor$ = SmartHold$
  363.       RETURN
  364. 58260 ZLinesPrinted = 0                     ' CS (Clear screen line count reset)
  365.       SmartHold$ = ""
  366.       RETURN
  367. 58261 ZLinesPrinted = ZPageLength           ' PB Page Break
  368.       IF ZNonStop THEN _                    ' force a 1-time pause
  369.          ZOneStop = ZTrue : _               ' if NON STOP is on
  370.          ZNonStop = ZFalse
  371.       SmartHold$ = ""
  372.       ZForceKeyboard = ZTrue
  373.       RETURN
  374. 58262 ZNonStop = ZTrue                      ' NS Non-stop
  375.       SmartHold$ = ""
  376.       RETURN
  377. 58263 IF ZGlobalSysop THEN _                ' FN First Name
  378.          SmartHold$ = ZOrigSysopFN$ _
  379.       ELSE SmartHold$ = ZFirstName$
  380.       CALL NameCaps(SmartHold$)
  381.       RETURN
  382. 58264 IF ZGlobalSysop THEN _
  383.          SmartHold$ = ZOrigSysopLN$ _
  384.       ELSE SmartHold$ = ZLastName$
  385.       CALL NameCaps(SmartHold$)
  386.       RETURN
  387. 58265 SmartHold$ = MID$(STR$(ZUserSecLevel),2)   ' SL Security level
  388.       RETURN
  389. 58266 SmartHold$ = DATE$                         ' DT Date           ' KG021801
  390.       RETURN
  391. 58267 CALL AMorPM
  392.       SmartHold$ = ZTime$                        ' TM Time           ' KG021801
  393.       RETURN
  394. 58268 CALL TimeRemain(MinsRemaining)
  395.       SmartHold$ = MID$(STR$(INT(MinsRemaining)),2)
  396.       RETURN
  397. 58269 CALL TimeRemain(MinsRemaining)      ' TE Time elapsed (mm:ss)
  398.       SmartHold$ = MID$(STR$(INT(ZSecsUsedSession!/60)),2)+":"+ _
  399.          MID$(STR$((ZSecsUsedSession! MOD 60)+100),3)
  400.       RETURN
  401. 58270 SmartHold$ = MID$(STR$(INT((ZTimeLockSet+0.5)/60)),2) ' TL - Time Lock period
  402.       SmartHold$ = SmartHold$ + ":"+ MID$(STR$((ZTimeLockSet MOD 60)+100),3)
  403.       RETURN
  404. 58271 SmartHold$ = MID$(STR$(ZDaysInRegPeriod),2)
  405.       RETURN                                ' RP Registration Length
  406. 58272 SmartHold$ = MID$(STR$(ZRegDaysRemaining),2)
  407.       RETURN                                ' RR Registration Remaining
  408. 58273 SmartHold$ = ZCityState$              ' CT Users CITY & STATE
  409.       RETURN
  410. 58274 SmartHold$ = ZFG1$                    ' C1 Color 1
  411.       GOTO 58258
  412. 58275 SmartHold$ = ZFG2$                    ' C2 Color 2
  413.       GOTO 58258
  414. 58276 SmartHold$ = ZFG3$                    ' C3 Color 3
  415.       GOTO 58258
  416. 58277 SmartHold$ = ZFG4$                    ' C4 Color 4
  417.       GOTO 58258
  418. 58278 SmartHold$ = ZEmphasizeOff$           ' C0 Reset color
  419.       ZLastSmartColor$ = ""
  420.       RETURN
  421. 58279 SmartHold$ = MID$(STR$(INT(ZDLToday!)),2)
  422.       RETURN                                ' DD files Dnlded TODAY
  423. 58280 SmartHold$ = MID$(STR$(INT(ZBytesToday!)),2)
  424.       RETURN                                ' BD Bytes Dnlded TODAY
  425. 58281 SmartHold$ = MID$(STR$(INT(ZDLBytes!)),2)
  426.       RETURN                                ' DB Download Bytes
  427. 58282 SmartHold$ = MID$(STR$(INT(ZULBytes!)),2)
  428.       RETURN                                ' UB Upload Bytes
  429. 58283 SmartHold$ = MID$(STR$(ZDnlds),2)     ' DL Number of Dnlds
  430.       RETURN
  431. 58284 SmartHold$ = MID$(STR$(ZUplds),2)     ' UL Number of Uplds
  432.       RETURN
  433. 58285 SmartHold$ = ZFileName$               ' FI  File Name
  434.       RETURN
  435. 58286 Overlay = ZTrue                       ' VY Overlay ON
  436.       GOTO 58288
  437. 58287 Overlay = ZFalse                      ' VN Overlay OFF
  438. 58288 SmartHold$ = ""
  439.       RETURN
  440. 58289 TrimSmart = ZTrue                     ' TY Trim Yes
  441.       GOTO 58288
  442. 58290 TrimSmart = ZFalse                    ' TN Trim No
  443.       GOTO 58288
  444. 58291 SmartHold$ = ZRBBSName$               ' BN Board Name
  445.       RETURN
  446. 58292 SmartHold$ = ZNodeID$                 ' ND Node Number
  447.       IF SmartHold$ >= "A" THEN _
  448.          SmartHold$ = MID$(STR$(ASC(SmartHold$) - 54),2)
  449.       RETURN
  450. 58293 SmartHold$ = ZSysopFirstName$          ' FS Sysops First Name
  451.       CALL NameCaps(SmartHold$)
  452.       RETURN
  453. 58294 SmartHold$ = ZSysopLastName$          ' LS Sysops First Name
  454.       CALL NameCaps(SmartHold$)
  455.       RETURN
  456.       END SUB
  457. '
  458. 58300 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF'
  459. ' $PAGE
  460. '
  461. '  NAME    -- BufString
  462. '
  463. '  INPUTS  -- PARAMETER                      MEANING
  464. '             Strng$                  STRING TO BE WRITTEN OUT
  465. '             DataSize               LENGTH OF STRING - # LEFT
  466. '                                        CHARS TO OUTPUT
  467. '
  468. '  OUTPUTS -- Strng$                  IS WRITTEN TO THE USER
  469. '
  470. '  PURPOSE -- To search the string, Strng$, for embedded carriage
  471. '             returns and line feeds and write out each line with
  472. '             the appropriate substitution (cr/lf if to the local
  473. '             screen or cr/nulls/lf if to the communications port).
  474. '
  475.       SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC
  476.       WasL = LEN(Strng$)
  477.       IF PassedDataSize < WasL THEN _
  478.          WasL = PassedDataSize
  479.       IF WasL < 1 THEN _
  480.          EXIT SUB
  481.       ZFF = ZPageLength - 1
  482.       StartByte = 1
  483.       ZRet = ZFalse
  484.       IF CarryOver THEN _
  485.          IF ASC(Strng$) = 10 THEN _
  486.             StartByte = 2 : _
  487.             CALL SkipLine (1+ZJumpSearching)
  488.       CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$)
  489.       WasL = WasL + CarryOver
  490. 58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  491.       IF CRat > 0 AND CRat < WasL THEN _
  492.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  493.       ELSE CRFound = ZFalse
  494.       EOLlen = -2 * CRFound
  495.       IF CRFound THEN _
  496.          EOD = CRat _
  497.       ELSE EOD = WasL + 1
  498.       NumBytes = EOD - StartByte
  499.       StringWork$ = MID$(Strng$,StartByte,NumBytes)
  500.       IF NOT ZDeleteInvalid THEN _
  501.          GOTO 58302                                                  ' DA061002
  502.       Index = INSTR(StringWork$,"[")
  503.       WasJ = LEN(StringWork$) - 1
  504.       WHILE Index > 0 AND Index < WasJ
  505.          IF MID$(StringWork$,Index + 2,1) = "]" THEN _
  506.             IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _
  507.                MID$(StringWork$,Index + 1,1) = "*"
  508.          Index = INSTR(Index + 1,StringWork$,"[")
  509.       WEND
  510. 58302 IF ZJumpSearching THEN _                                       ' DA061002
  511.          Temp$ = StringWork$ : _
  512.          CALL AllCaps (Temp$) : _
  513.          HiLitePos = INSTR (Temp$,ZJumpTo$) : _
  514.          IF HiLitePos = 0 THEN _
  515.             GOTO 58307 _
  516.          ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _
  517.               ZJumpSearching = ZFalse
  518.       IF ZSmartTextCode THEN _
  519.          CALL SmartText (StringWork$, CRFound, ZFalse)
  520.       IF NOT ZLocalUser THEN _                                       ' DA061002
  521.          CALL EofComm (Char) : _                                     ' DA061002
  522.          IF Char <> -1 THEN _                                        ' DA061002
  523.             GOTO 58303            ' comm port input                  ' DA061002
  524.       ZKeyboardStack$ = INKEY$ : _                                   ' DA061002
  525.       IF ZKeyboardStack$ <> "" THEN _  ' keyboard input              ' DA061002
  526.          GOTO 58303                                                  ' DA061002
  527.       CALL QuickTPut (StringWork$, - (CRFound))                      ' DA061002
  528.       GOTO 58304                                                     ' DA061002
  529. 58303 ZOutTxt$ = StringWork$                                         ' DA061002
  530.       ZSubParm = 4                                                   ' DA061002
  531.       IF CRFound THEN ZSubParm = 5                                   ' DA061002
  532.       CALL TPut                                                      ' DA061002
  533. 58304 IF ZRet THEN _                                                 ' DA061002
  534.          EXIT SUB
  535.       IF ZLinesPrinted < ZFF THEN _
  536.          GOTO 58307
  537. 58305 CALL CheckTimeRemain (MinsRemaining)
  538.       CALL CheckCarrier
  539.       IF ZSubParm = -1 THEN _
  540.          EXIT SUB
  541.       IF ZNonStop THEN _
  542.          GOTO 58307
  543.       IF NOT CRFound THEN _
  544.          GOTO 58307
  545.       ZForceKeyboard = ZTrue
  546.       CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts)
  547.       IF ZNo THEN _
  548.          ZRet = ZTrue : _
  549.          EXIT SUB
  550. 58307 StartByte = EOD + EOLlen
  551.       IF StartByte <= WasL THEN _
  552.          GOTO 58301
  553.       END SUB
  554. 58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
  555. ' $PAGE
  556. '
  557. '  NAME    -- BufFile
  558. '
  559. '  INPUTS  -- PARAMETER                      MEANING
  560. '             FileSpec$               NAME OF THE FILE TO WRITE TO
  561. '                                                OUT TO THE USER
  562. '
  563. '  OUTPUTS -- NONE                    FILE IS WRITTEN TO THE USER
  564. '
  565. '  PURPOSE -- To display a sequential file to the user
  566. '
  567.       SUB BufFile (FilName$,AbortIndex) STATIC
  568.       CALL FindIt (FilName$)
  569.       IF NOT ZOK THEN _
  570.          GOTO 58419
  571.       ZNo = ZFalse
  572.       CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
  573.       DataSize = ZBufferSize
  574.       FIELD 2, DataSize AS SeqRec$
  575.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  576.       ZJumpLast$ = ""
  577.       ZJumpSearching = ZFalse
  578.       ZJumpSupported = ZTrue
  579.       IF NOT ZStopInterrupts THEN _
  580.          IF NOT ZConcatFIles THEN _
  581.             IF NOT ZNonStop THEN _
  582.                ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _
  583.                ZSubParm = 2 : _
  584.                CALL TPut
  585.       WasTU = 0
  586. 58405 WasTU = WasTU + 1
  587.       IF WasTU < NumRecs THEN _
  588.          GET 2,WasTU _
  589.       ELSE IF WasTU = NumRecs THEN _
  590.               GET 2,WasTU : _
  591.               WasX = INSTR(SeqRec$,CHR$(26)) : _
  592.               IF WasX = 0 OR WasX > LenLastRec THEN _
  593.                  DataSize = LenLastRec _
  594.               ELSE DataSize = WasX - 1 _
  595.            ELSE GOTO 58419
  596.       CALL BufString (SeqRec$,DataSize,AbortIndex)                   ' DA061002
  597. 58408 IF ZSubParm <> -1 AND NOT ZRet THEN _
  598.          GOTO 58405
  599. 58419 CLOSE 2
  600.       ZBypassTimeCheck = ZFalse
  601.       ZStopInterrupts = ZFalse
  602.       CALL QuickTPut (ZEmphasizeOff$,0)
  603.       ZJumpSupported = ZFalse
  604.       END SUB
  605. 58600 ' $SUBTITLE: 'FindLast - find last occurence of a string'
  606. ' $PAGE
  607. '
  608. '  NAME    -- FindLast
  609. '
  610. '  INPUTS  -- PARAMETER             MEANING
  611. '              LookIn$           STRING TO LOOK INTO
  612. '              LookFor$          STRING TO SEARCH FOR
  613. '
  614. '  OUTPUTS -- WhereFound        POSITION IN LookIn$ THAT
  615. '                                   LookFor$ Found
  616. '             NumFinds          HOW MANY OCCURENCES IN LookIn$
  617. '
  618. '  PURPOSE -- Finds last occurence of LookFor$ in LookIn$ and
  619. '             returns count of # of occurences.  If none found,
  620. '             both returned parameters are set to 0.
  621. '
  622.       SUB FindLast (LookIn$,LookFor$,WhereFound,NumFinds) STATIC
  623.       WhereFound = INSTR(LookIn$,LookFor$)
  624.       NumFinds = -(WhereFound > 0)
  625.       NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  626.       WHILE NextFound > 0
  627.          NumFinds = NumFinds + 1
  628.          WhereFound = NextFound
  629.          NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  630.       WEND
  631.       END SUB
  632. 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file'
  633. ' $PAGE
  634. '
  635. '  NAME    -- RotorsDir
  636. '
  637. '  INPUTS  --     PARAMETER                    MEANING
  638. '             FilName$                  FILE NAME TO LOOK FOR
  639. '             SDIR.ARA                  ARRAY OF SUBDIRECTORIES
  640. '             MaxSearch                 MAX # OF SUBDIRECTORIES
  641. '             MarkingTime               WHETHER TO MARK TIME
  642. '
  643. '  OUTPUTS -- FNAME$                    ADD SUBDIRECTORY TO THE
  644. '                                       FILE NAME IF FOUND.  OTHER-
  645. '                                       WISE DON'T.
  646. '             ZOK                       TRUE IF FILE WAS Found
  647. '
  648. '  PURPOSE -- Hunt through a list of subdirectories to determine
  649. '             if a file is in any of them.  If file is found, open
  650. '             the file as file #2, add the drive/path to the file
  651. '             name, and sets ZOK to true.  If file isn't found, set
  652. '             file name to the last subdirectory searched -- which
  653. '             should be the upload subdirectory.
  654. '
  655. '             If the library menu is selected (ZMenuIndex = 6), then
  656. '             only 2 subdirectories are searched. The first being
  657. '             the work disk and the second being the selected
  658. '             library disk.
  659. '
  660.       SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC ' KG022204
  661.       ZOK = ZFalse
  662.       ZDotFlag = ZFalse
  663.       IF MarkingTime THEN _
  664.          CALL QuickTPut ("Searching for "+FilName$,0)
  665.       IF ZMenuIndex = 6 THEN _
  666.          GOTO 58705
  667.       NumSearch = 1
  668.       WasX = 0
  669.       WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _
  670.          SDirAra$(NumSearch) <> ""
  671.          IF MarkingTime THEN _
  672.             CALL MarkTime (WasX)
  673.          WasX$ = SDirAra$(NumSearch) + _
  674.               FilName$
  675.          CALL FindFile (WasX$,ZOK)
  676.          NumSearch = NumSearch + 1
  677.       WEND
  678.       IF ZOK OR NOT ZFastFileSearch THEN _                           ' KG022301
  679.          GOTO 58710                                                  ' KG022301
  680.       CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18)                 ' KG022301
  681.       IF ZErrCode <> 0 THEN _                                        ' KG022301
  682.          GOTO 58710                                                  ' KG022301
  683.       CALL TrimTrail (FilName$,".")
  684.       CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$)
  685.       ZOK = (RecFoundAt > 0)
  686.       IF NOT ZOK THEN _                                              ' KG022301
  687.          GOTO 58710                                                  ' KG022301
  688.       ZOK = ZFalse
  689.       CALL CheckInt (MID$(RecFound$,13,4))
  690.       IF ZTestedIntValue < 1 THEN _                                  ' KG022301
  691.          GOTO 58710                                                  ' KG022301
  692.       CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66)
  693.       IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _           ' KG022301
  694.          GOTO 58710                                                  ' KG022301
  695.       FIELD 2, 66 AS LocatorRec$
  696.       GET 2, ZTestedIntValue
  697.       WasX$ = LEFT$(LocatorRec$,63)
  698.       CALL Trim (WasX$)
  699.       IF LEFT$(WasX$,2) = "M!" THEN _
  700.          ZOK = ZFalse : _                                            ' KG022301
  701.          ZGSRAra$(1) = PassToMacro$ : _                              ' KG022204
  702.          WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _                      ' KG022204
  703.          CALL Trim (WasX$) : _                                       ' KG022204
  704.          ZFileLocation$ = "" : _                                     ' KG022301
  705.          CALL MacroExe (WasX$) : _                                   ' KG022204
  706.          IF ZFileLocation$ = "" THEN _                               ' KG022301
  707.             ZOK = ZFalse : _                                         ' KG022204
  708.             GOTO 58711 _                                             ' KG022301
  709.          ELSE WasX$ = ZFileLocation$                                 ' KG022301
  710.       WasX$ = WasX$ + FilName$                                       ' KG022301
  711.       CALL FindFile (WasX$,ZOK)                                      ' KG022301
  712.       GOTO 58710                                                     ' KG022301
  713. 58705 WasX$ = ZLibWorkDiskPath$ + _
  714.            FilName$
  715.       CALL FindIt (WasX$)
  716.       IF ZOK THEN _
  717.          GOTO 58710
  718.       WasX$ = ZLibDrive$ + _
  719.            FilName$
  720.       CALL FindIt (WasX$)
  721. 58710 FilName$ = WasX$
  722. 58711 CALL SkipLine (-MarkingTime)                                   ' KG021802
  723.       END SUB
  724. 58800 ' $SUBTITLE: 'WipeLine - Wipe away a line so next overprints'
  725. ' $PAGE
  726. '
  727. '  NAME    -- WipeLine
  728. '
  729. '  INPUTS  --     PARAMETER                    MEANING
  730. '                 ZCarriageReturn$
  731. '                 CharsToWipe            # OF CHARACTERS TO BLANK
  732. '                 ZNulls
  733. '
  734. '  OUTPUTS -- NONE
  735. '
  736. '  PURPOSE -- Wipe away a line and leave cursor at beginning of the
  737. '             same line so that the next line will print in its place
  738. '
  739.       SUB WipeLine (CharsToWipe) STATIC
  740.       IF ZNulls OR CharsToWipe > 79 THEN _
  741.          CALL SkipLine (1) : _
  742.          EXIT SUB
  743.       IF NOT ZLocalUser THEN _
  744.          Strng$ = ZCarriageReturn$ + SPACE$(CharsToWipe) + ZCarriageReturn$ : _
  745.          IF ZFossil THEN _
  746.             Bytes = LEN(Strng$) : _
  747.             CALL FosWrite(ZComPort,Bytes,Strng$) _
  748.          ELSE PRINT #3,Strng$
  749.       IF ZSnoop THEN _
  750.          LOCATE ,1 :  _
  751.          CALL LPrnt(SPACE$(CharsToWipe),0) : _
  752.          LOCATE ,1
  753.       IF ZF7Msg$ = "" OR _
  754.          ZF7Msg$ = "NONE" OR _
  755.          NOT ZSysopNext THEN _
  756.          EXIT SUB
  757.       ZBypassTimeCheck = ZTrue
  758.       CALL BufFile (ZF7Msg$,WasX)
  759.       END SUB
  760. 58895 ' $SUBTITLE: 'GetDirs -- Prompt for directories to search'
  761. ' $PAGE
  762. '
  763. '  NAME    -- GetDirs
  764. '
  765. '  INPUTS  --     PARAMETER                    MEANING
  766. '                 ZDirPrompt$             BASE OF DIRECTORY PROMPT
  767. '                 ShowHelp               Whether to display help
  768. '                                            on entry
  769. '  OUTPUTS --     ZUserIn$
  770. '                 ZWasQ
  771. '
  772. '  PURPOSE -- Prompt for directories to search
  773. '
  774.       SUB GetDirs (ShowHelp) STATIC
  775.       IF ShowHelp AND (ZAnsIndex >= ZLastIndex ) THEN _
  776.          GOTO 58902
  777. 58900 ZOutTxt$ = ZDirPrompt$
  778.       ZMacroMin = 2
  779.       CALL PopCmdStack
  780.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  781.          EXIT SUB
  782.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  783.       IF ZUserIn$(ZAnsIndex) = "Q" THEN _
  784.          ZWasQ = 0 : _
  785.          EXIT SUB
  786.       ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
  787.       IF ZWasA = 0 THEN _
  788.          EXIT SUB
  789.       IF ZWasA > 8 THEN _
  790.          IF ZAnsIndex < ZLastIndex THEN _
  791.             GOTO 58900 _
  792.          ELSE GOTO 58902
  793.       IF ZWasA = 7 THEN _
  794.          ZExtendedOff = NOT ZExtendedOff _
  795.       ELSE ZExtendedOff = (ZWasA > 3)
  796.       CALL QuickTPut1 ("Extended directory display "+FNOffOn$(NOT ZExtendedOff)) ' DA071801
  797.       GOTO 58900
  798. 58902 ZFileName$ = ZCurDirPath$ + ZDirPrefix$ + _
  799.                     "." + ZDirExtension$
  800.       GDefault$ = MID$(" GC",ZWasGR + 1, 1)
  801.       CALL Graphic (GDefault$,ZFileName$)
  802.       CALL BufFile (ZFileName$,ZAnsIndex)
  803.       GOTO 58900
  804.       END SUB
  805. '
  806. 58950 ' $SUBTITLE: 'ConvertDir -- Converts coded response to right directory'
  807. ' $PAGE
  808. '
  809. '  NAME    -- ConvertDir
  810. '
  811. '  INPUTS  --     PARAMETER                    MEANING
  812. '                 Start               ELEMENT TO BEGIN WITH
  813. '                 ZUserIn$            ARRAY TO CONVERT
  814. '                 ZWasQ               Last ELEMENT TO CONVERT
  815. '
  816. '  OUTPUTS --     ZUserIn$            CONVERTED DIRECTORY LIST
  817. '
  818. '  PURPOSE -- Let the user put in a short standard string for a directory
  819. '
  820. '
  821.       SUB ConvertDir (Start) STATIC
  822.       FOR WasI=Start TO ZLastIndex
  823.          CALL AllCaps (ZUserIn$(WasI))
  824.          IF ZUserIn$(WasI)="U" THEN _
  825.             ZUserIn$(WasI) = ZUpldDirCheck$
  826.          IF ZUserIn$(WasI) = "A" THEN _
  827.             ZUserIn$(WasI) = "ALL"
  828.       NEXT
  829.       END SUB
  830. 59100 ' $SUBTITLE: 'Muzak - subroutine to PLAY ZMusic'
  831. ' $PAGE
  832. '
  833. '  NAME    -- Muzak
  834. '
  835. '  INPUTS  --   PARAMETER     MEANING
  836. '                       1   PLAY CONSIDER YOURSELF(OPENING SCREEN)
  837. '                       2   PLAY WALK RIGHT IN(NEW USERS)
  838. '                       3   PLAY DRAGNET (SECURITY VIOLATION)
  839. '                       4   PLAY GOODBYE CHARLIE (GOODBYE)
  840. '                       5   PLAY TAPS (ACCESS DENIED)
  841. '                       6   PLAY OOM PAH PAH (DOWNLOAD)
  842. '                       7   PLAY THNKS FOR MEMORIES(UPLOAD)
  843. '
  844. '  OUTPUTS -- NONE
  845. '
  846. '  PURPOSE -- Provide sysops and the visually impaired with
  847. '             auditory feedback on what RBBS-PC is doing
  848. '
  849.       SUB Muzak (PassedArg) STATIC
  850.       ZFF = PassedArg
  851.       ZSubParm = 0
  852.       IF (NOT ZSnoop) OR (NOT ZMusic) OR ZLocalUserMode THEN _
  853.          EXIT SUB
  854.       ON ZFF GOTO 59102,59104,59106,59108,59110,59112,59114
  855.       EXIT SUB
  856. 59102 '---[Introduction CONSIDER YOURSELF]---
  857.     Music$ = "MBT180A4B-8B-8B-8B-2.G4A8F2"
  858.     PLAY "O2 X" + VARPTR$(Music$)
  859.     EXIT SUB
  860. 59104 '---[New User WALK RIGHT IN]---
  861.     Music1$ = "MBT180G4G4D2G8F+8F8E2A8B8"
  862.     Music2$ = "C8C+8D8C8"
  863.     Music3$ = "B4G2"
  864.     PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
  865.     EXIT SUB
  866. 59106 '---[Security Violation DRAGNET THEME]---
  867.      Music$ = "MBT120C2D8E-4C2.C2D8E-4C4G-2."
  868.      PLAY "O2 X" + VARPTR$(Music$)
  869.      EXIT SUB
  870. 59108 '---[Goodbye GOODBYE CHARLIE]---
  871.       Music$ = "MBT180B-2.G2.F4D2."
  872.       PLAY "O2 X" + VARPTR$(Music$)
  873.       EXIT SUB
  874. 59110 '---[Access Denied TAPS]---
  875.       Music1$ = "MBT90F8A16"
  876.       Music2$ = "C4."
  877.       Music3$ = "A4F4C2.C8C16F2"
  878.       PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
  879.       EXIT SUB
  880. 59112 '---[Download OOM PAH PAH]---
  881.        Music$ = "MBT180F4A4A4C4A4A4G4A4G4D2"
  882.        PLAY "O2 X" + VARPTR$(Music$)
  883.        EXIT SUB
  884. 59114 '---[Upload THANKS FOR THE MEMORIES]---
  885.        Music1$ = "MBT180C2."
  886.        Music2$ = "A8G8F4D2"
  887.        PLAY "O3 X" + VARPTR$(Music1$) + "O2 X" + VARPTR$(Music2$)
  888.        END SUB
  889. 59200 ' $SUBTITLE: 'TwoByteDate -- subroutine to put date in 2 bytes'
  890. ' $PAGE
  891. '
  892. '  NAME    -- TwoByteDate
  893. '
  894. '  INPUTS  --   PARAMETER     MEANING
  895. '                  Year       FOUR DIGIT YEAR (I.E. 1987)
  896. '                  WasMM      MONTH
  897. '                  WasDD      DAY
  898. '                Result$      LOCATION TO PLACE THE Result
  899. '
  900. '  OUTPUTS -- Result$       TWO BYTE COMPRESSED DATE FOR USE IN
  901. '                           A RANDOM RECORD
  902. '
  903. '  PURPOSE -- Compress a WasY,ZMsgPtr,WasD date into two characters
  904. '
  905.       SUB TwoByteDate (Year,WasMM,WasDD,Result$) STATIC
  906.       Result$ = CHR$(((Year - 1980) * 2) OR - ((WasMM AND 8) <> 0)) + _
  907.                 CHR$((WasMM AND NOT 8) * 32 + WasDD)
  908.       END SUB
  909. 59201 ' $SUBTITLE: 'PackDate -- subroutine to Compress STRING DATE'
  910. ' $PAGE
  911. '
  912. '  NAME    -- PackDate
  913. '
  914. '  INPUTS  --   PARAMETER     MEANING
  915. '                 Strng$    String Date (mm-dd-yyyy)
  916. '
  917. '  OUTPUTS --    Result$    TWO BYTE COMPRESSED DATE FOR USE IN
  918. '                                      A RANDOM RECORD
  919. '
  920. '  PURPOSE -- Compress an 8-character date into two characters
  921. '
  922.       SUB PackDate (Strng$,Result$) STATIC
  923.       IF LEN(Strng$) < 8 THEN _
  924.          EXIT SUB
  925.       Year = VAL(MID$(Strng$,7))
  926.       WasMM = VAL(Strng$)
  927.       WasDD = VAL(MID$(Strng$,4))
  928.       CALL TwoByteDate (Year,WasMM,WasDD,Result$)
  929.       END SUB
  930. 59202 ' $SUBTITLE: 'UnPackDate -- subroutine to UNCompress DATE'
  931. ' $PAGE
  932. '
  933. '  NAME    -- UnPackDate
  934. '
  935. '  INPUTS  --   PARAMETER      MEANING
  936. '             CompressedDate$ Date in 2 byte compressed form
  937. '
  938. '  OUTPUTS --     Year           Year of compressed date
  939. '                 WasMM          Month of compressed date
  940. '                 WasDD          Day of compressed date
  941. '             DisplayDate$       8 char display date (mm-dd-yyyy)
  942. '
  943. '  PURPOSE -- Uncompress a 2 char date to get Y,M,D & display
  944. '
  945.       SUB UnPackDate (CompressedDate$,Year,WasMM,WasDD,DisplayDate$) STATIC
  946.       CALL GetYMD (CompressedDate$,1,Year)
  947.       CALL GetYMD (CompressedDate$,2,WasMM)
  948.       CALL GetYMD (CompressedDate$,3,WasDD)
  949.       DisplayDate$ = RIGHT$("00" + MID$(STR$(WasMM),2),2) + _
  950.                       "-" + _
  951.                       RIGHT$("00" + MID$(STR$(WasDD),2),2) + _
  952.                       "-" + _
  953.                       RIGHT$(STR$(Year),2)
  954.       END SUB
  955. 59204 ' $SUBTITLE: 'GetYMD -- subroutine to unpack a two-byte date'
  956. ' $PAGE
  957. '
  958. '  NAME    -- GetYMD
  959. '
  960. '  INPUTS  --   PARAMETER     MEANING
  961. '                 TwoByte$    PACKED TWO-BYTE DATE FIELD
  962. '                   YMD       1 = YEAR
  963. '                             2 = MONTH
  964. '                             3 = DAY
  965. '                 Result      LOCATION TO PLACE THE Result
  966. '
  967. '  OUTPUTS -- Result        FOUR DIGIT Result OF UNPAKING THE DATE
  968. '
  969. '  PURPOSE -- Unpack a compressed two-byte date field
  970. '
  971.       SUB GetYMD (TwoByte$,YMD,Result) STATIC
  972.       ON YMD GOTO 59206,59210,59215
  973.       EXIT SUB
  974. 59206 Result = (ASC(TwoByte$)AND NOT 1) / 2 + 1980
  975.       EXIT SUB
  976. 59210 Result = FIX((ASC(MID$(TwoByte$,2)) / 32)) OR ((ASC(TwoByte$) AND 1) * 8)
  977.       EXIT SUB
  978. 59215 Result = ASC(MID$(TwoByte$,2)) AND NOT 224
  979.       END SUB
  980. 59300 ' $SUBTITLE: 'PersFile - processes requests for personal files'
  981. ' $PAGE
  982. '
  983. '  NAME    -- PersFile
  984. '
  985. '  INPUTS  --     PARAMETER           MEANING
  986. '                 PersonalCat$     CATEGORY IN DIR FOR CALLER
  987. '                 ZPersonalLen      # CHARS IN PERSONAL CATEGORY
  988. '  OUTPUTS -- NONE UP ZDnlds
  989. '
  990. '  PURPOSE -- Show caller what personal files have for downloading,
  991. '             verify and process requests for downloads
  992. '
  993.       SUB PersFile (PersonalCat$,DnldFlag) STATIC
  994.       CALL FindIt (ZPersonalDir$)
  995. 59302 IF NOT ZOK THEN _
  996.          CALL QuickTPut1 ("No personal files available") : _
  997.          ZLastIndex = 0 : _
  998.          EXIT SUB
  999.       GOSUB 59338
  1000.       IF LOF(2) < WasL THEN _
  1001.         ZOK = ZFalse : _
  1002.         GOTO 59302
  1003.       ZUserIn$(0) = ""
  1004.       MaxPrint = ZPageLength - 1
  1005.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  1006.       ZStopInterrupts = ZFalse
  1007.       IF Downloading THEN _
  1008.          Downloading = ZFalse : _
  1009.          PersIndex = DnldFlag : _
  1010.          DnldFlag = 0 : _
  1011.          GOTO 59306
  1012. 59303 CALL QuickTPut (ZEmphasizeOff$,0)                              ' KG030202
  1013.       ZOutTxt$ = "Download what: L)ist, * = new, or file(s)" + _
  1014.            ZPressEnterExpert$
  1015.       ZMacroMin = 99
  1016.       ZStackC = ZTrue
  1017.       CALL PopCmdStack
  1018.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1019.          ZLastIndex = 0 : _
  1020.          EXIT SUB
  1021. 59304 SelectedProtocol$ = ""
  1022.       IF ZLastIndex > 1 THEN _
  1023.          IF LEN(ZUserIn$(ZLastIndex)) = 1 THEN _
  1024.             SelectedProtocol$ = ZUserIn$(ZLastIndex) : _
  1025.             CALL AllCaps (SelectedProtocol$) : _                     ' KG081501
  1026.             IF INSTR(ZDefaultXfer$,SelectedProtocol$) = 0 THEN _     ' KG081501
  1027.                SelectedProtocol$ = "" _                              ' KG081501
  1028.             ELSE ZLastIndex = ZLastIndex - 1                         ' KG081501
  1029.       IF LEN(ZUserIn$(ZAnsIndex)) > 1 THEN _
  1030.          GOTO 59330
  1031.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  1032.       ON INSTR("L*",ZUserIn$(ZAnsIndex)) GOTO 59305,59327
  1033.       GOTO 59303
  1034. 59305 PersIndex = LastRec
  1035.       WasL = ZFalse
  1036. 59306 IF PersIndex < 1 THEN _
  1037.          IF WasL THEN _
  1038.             GOTO 59303 _
  1039.          ELSE _
  1040.             ZOutTxt$ = "No files for you" : _
  1041.                  CALL QuickTPut1 (ZOutTxt$) : _
  1042.               GOTO 59303
  1043.       GET #2,PersIndex
  1044.       PersIndex = PersIndex - 1
  1045.       IF ZSysop THEN _
  1046.          GOTO 59320
  1047.       IF ASC(PrivateCat$) = 32 THEN _
  1048.          IF ZUserSecLevel < VAL(PrivateCat$) THEN _
  1049.             GOTO 59306 _
  1050.          ELSE GOTO 59308
  1051.       IF PersonalCat$ <> PrivateCat$ THEN _
  1052.          GOTO 59306
  1053. 59308 WasL = ZTrue
  1054.       FilName$ = ZPersonalDrvPath$ + _
  1055.                  LEFT$(PartToPrint$,12)
  1056. 59320 ZOutTxt$ = PartToPrint$
  1057.       IF PersonalStatus$ = "*" AND LEFT$(ZOutTxt$,1) <> " " THEN _
  1058.          MID$(ZOutTxt$, INSTR(ZOutTxt$," ")) = "*"                   ' DA080903
  1059.       CALL ColorDir (ZOutTxt$,"Y")
  1060.       IF ZLocalUser THEN _
  1061.          GOTO 59322
  1062.       CALL EofComm (Char)
  1063.       IF Char <> -1 THEN _
  1064.          GOTO 59323            ' comm port input
  1065. 59322 ZKeyboardStack$ = INKEY$
  1066. 59323 ZSubParm = 5
  1067.       CALL TPut
  1068.       IF ZRet THEN _
  1069.          GOTO 59303
  1070.       IF ZSubParm = -1 THEN _
  1071.          GOTO 59335
  1072. 59324 IF ZLinesPrinted <= MaxPrint THEN _
  1073.          GOTO 59306
  1074.       CALL TimeRemain (MinsRemaining)
  1075.       IF MinsRemaining <= 0 THEN _
  1076.          ZSubParm = -1 : _
  1077.          GOTO 59335
  1078.       CALL Carrier
  1079.       IF ZSubParm = -1 THEN _
  1080.          GOTO 59335
  1081.       IF ZNonStop THEN _
  1082.          GOTO 59306
  1083. 59325 IF PersIndex > 0 THEN _
  1084.          ZOutTxt$ = "MORE: [Y],N,C or download what (* = new)" _
  1085.       ELSE GOTO 59303
  1086.       ZNoAdvance = ZTrue
  1087.       ZMacroMin = 99
  1088.       ZStackC = ZTrue
  1089.       CALL PopCmdStack
  1090.       IF ZSubParm = -1 THEN _
  1091.          GOTO 59335
  1092.       ZNonStop = (ZNonStop OR INSTR(" Cc",ZUserIn$) > 1)
  1093.       IF PersIndex < 1 AND ZWasQ = 0 THEN _
  1094.          GOTO 59335
  1095.       CALL WipeLine (78)
  1096.       IF ZNo THEN _
  1097.          GOTO 59303
  1098.       IF LEN(ZUserIn$(ZAnsIndex)) > 2 THEN _
  1099.          GOTO 59304
  1100.       GOTO 59306
  1101. 59327 PersIndex = LastRec        ' handle new files
  1102.       ZLastIndex = 0
  1103.       WHILE PersIndex > 0 AND  ZLastIndex < UBOUND(ZUserIn$)
  1104.          GET 2,PersIndex
  1105.          IF PersonalCat$ <> PrivateCat$ THEN _
  1106.             GOTO 59329
  1107.          IF PersonalStatus$ <> "*" THEN _
  1108.             GOTO 59329
  1109.          ZLastIndex = ZLastIndex + 1
  1110.          WasI = ZLastIndex
  1111.          GOSUB 59336
  1112.          IF ZOK THEN _
  1113.             WasX$ = MID$(STR$(PersIndex),2) : _
  1114.             ZUserIn$(0) = ZUserIn$(0) + _
  1115.                     WasX$ + _
  1116.                     SPACE$(5 - LEN(WasX$)) _
  1117.          ELSE ZLastIndex = ZLastIndex - 1
  1118. 59329    PersIndex = PersIndex - 1
  1119.       WEND
  1120.       IF ZLastIndex = 0 THEN _
  1121.          ZOutTxt$ = "No new files for you" : _
  1122.          CALL QuickTPut1 (ZOutTxt$) : _
  1123.          GOTO 59303
  1124.       ZAnsIndex = 1
  1125.       GOTO 59332
  1126. 59330 WasI = ZAnsIndex              ' handle list of files
  1127.       WHILE WasI <= ZLastIndex
  1128.          ZOK = ZFalse
  1129.          WasJ = LastRec + 1
  1130.          CALL AllCaps (ZUserIn$(WasI))
  1131.          WasX = INSTR(ZUserIn$(WasI),".")
  1132.          IF WasX = 0 THEN _
  1133.             ZUserIn$(WasI) = ZUserIn$(WasI) + "." + ZDefaultExtension$ _
  1134.          ELSE IF WasX = LEN(ZUserIn$(WasI)) THEN _
  1135.                  ZUserIn$(WasI) = LEFT$(ZUserIn$(WasI),WasX-1)
  1136.          WHILE WasJ > 1 AND NOT ZOK
  1137.             WasJ = WasJ - 1
  1138.             GET #2,WasJ
  1139.             IF (PersonalCat$ = PrivateCat$ OR _
  1140.                (ASC(PrivateCat$) = 32 AND _
  1141.                 ZUserSecLevel => VAL(PrivateCat$))) THEN _
  1142.                    ZOK = (ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1))
  1143.          WEND
  1144.          IF ZOK THEN _
  1145.             GOSUB 59336 : _
  1146.             IF ZOK THEN _
  1147.                WasX$ = MID$(STR$(WasJ),2) : _
  1148.                ZUserIn$(0) = ZUserIn$(0) + _
  1149.                        WasX$ + _
  1150.                        SPACE$(5 - LEN(WasX$))
  1151.          IF NOT ZOK THEN _
  1152.             CALL QuickTPut1 (ZUserIn$(WasI) + " not found - omitted") : _
  1153.             FOR WasK = WasI + 1 TO ZLastIndex : _
  1154.                ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
  1155.             NEXT : _
  1156.             ZLastIndex = ZLastIndex - 1 : _
  1157.             WasI = WasI - 1
  1158.          WasI = WasI + 1
  1159.       WEND
  1160.       IF ZLastIndex = 0 THEN _
  1161.          GOTO 59303
  1162. 59332 DnldFlag = PersIndex          ' set protocol
  1163.       Downloading = ZTrue
  1164.       ZWasB = 1
  1165.       IF SelectedProtocol$ = "" THEN _
  1166.          IF ZPersonalProtocol$ <> " " THEN _
  1167.             SelectedProtocol$ = ZPersonalProtocol$
  1168.       IF SelectedProtocol$ <> "" THEN _
  1169.          ZLastIndex = ZLastIndex + 1 : _
  1170.          ZUserIn$(ZLastIndex) = SelectedProtocol$
  1171.       EXIT SUB
  1172. 59335 CLOSE 2
  1173.       EXIT SUB
  1174. 59336 ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
  1175.       CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
  1176.       IF ZOK THEN _
  1177.          ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
  1178.       ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
  1179.                       ((ZUserSecLevel < ZMinSecToView) OR _
  1180.                        NOT ZCanDnldFromUp),ZTrue,"D") : _            ' KG022204
  1181.            GOSUB 59338
  1182.       RETURN
  1183. 59338 CLOSE 2
  1184.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  1185.       IF ZShareIt THEN _
  1186.          OPEN ZPersonalDir$ FOR RANDOM SHARED AS #2 LEN=WasL _
  1187.       ELSE OPEN "R",2,ZPersonalDir$,WasL
  1188.       FIELD #2,33 + ZMaxDescLen AS PartToPrint$, _
  1189.                ZPersonalLen    AS PrivateCat$, _
  1190.                1               AS PersonalStatus$, _
  1191.                2               AS Filler$
  1192.       LastRec = LOF(2) / WasL
  1193.       RETURN
  1194.       END SUB
  1195. 59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads'
  1196. ' $PAGE
  1197. '
  1198. '  NAME    -- LogPDown
  1199. '
  1200. '  INPUTS  --   PARAMETER     MEANING
  1201. '
  1202. '  OUTPUTS --
  1203. '
  1204. '  PURPOSE -- Puts a "!" in place of an "*" in private directory
  1205. '             after downloaded
  1206. '
  1207.       SUB LogPDown (PrivateDnld,DwnIndex) STATIC                     ' RH021501
  1208.       IF NOT PrivateDnld THEN _
  1209.          EXIT SUB
  1210.       ZWasEN$ = ZPersonalDir$
  1211.       WasBX = &H4
  1212.       ZSubParm = 9
  1213.       CALL FileLock
  1214.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  1215.       CLOSE 2
  1216.       IF ZShareIt THEN _
  1217.          OPEN ZWasEN$ FOR RANDOM SHARED AS #2 LEN=WasL _
  1218.       ELSE OPEN "R",2,ZPersonalDir$,WasL
  1219.       FIELD #2,WasL AS PersonalRec$
  1220.       FOR Temp = 1 TO ZDownFiles                                     ' KG102702
  1221.          ZWasA = VAL(MID$(ZUserIn$(0),5 * (DwnIndex - Temp) + 1,5))  ' KG102702
  1222.          GET #2,ZWasA                                                ' KG102702
  1223.          MID$(PersonalRec$,WasL-2,1) = "!"                           ' KG102702
  1224.          PUT #2,ZWasA                                                ' KG102702
  1225.       NEXT                                                           ' KG102702
  1226.       CALL UnLockAppend
  1227.       END SUB
  1228. 59450 ' $SUBTITLE: 'UserFace - handles programmable user interface'
  1229. ' $PAGE
  1230. '
  1231. '  NAME    --  UserFace
  1232. '
  1233. '  INPUTS  --  PARAMETER                   MEANING
  1234. '              GDefault$            GRAPHICS DEFAULT TO USE
  1235. '              ZCurPUI$             PUI TO USE
  1236. '              ZExpertUser          WHETHER CALL IN EXPERT MODE
  1237. '
  1238. '  OUTPUTS --  ZWasQ
  1239. '              ZUserIn$()
  1240. '              ZWasZ$
  1241. '
  1242. '  PURPOSE --  When sysop overrides RBBS-PC's default user
  1243. '              interface (provides a MAIN.PUT), this routine
  1244. '              reads in the table of specifications, presents
  1245. '              the sysop menu, presents the prompt, verifies
  1246. '              that a valid option has been picked, determines
  1247. '              whether the option is another PUI, and passes
  1248. '              back choices to be processed.
  1249. '
  1250.       SUB UserFace (GDefault$) STATIC
  1251. 59455 IF ZPrevPUI$ = ZCurPUI$ THEN _
  1252.          GOTO 59458
  1253. 59456 ZFileName$ = ZCurPUI$
  1254.       CALL Graphic (GDefault$,ZFileName$)
  1255.       IF NOT ZOK THEN _
  1256.          CALL UpdtCalr ("Missing menu " + ZCurPUI$,2) : _
  1257.          ZCurPUI$ = ZPrevPUI$ : _
  1258.          GOTO 59456
  1259.       ZPrevPUI$ = ZCurPUI$
  1260.       LINE INPUT #2,ZFileName$
  1261.       LINE INPUT #2,Prompt$
  1262.       INPUT #2,ValidChoice$,ActualCommands$
  1263.       LINE INPUT #2,MenuChoice$
  1264.       LINE INPUT #2,MenuName$
  1265.       LINE INPUT #2,QuitCmd$
  1266.       LINE INPUT #2,QuitPrompt$
  1267.       LINE INPUT #2,QuitSubCmds$
  1268.       LINE INPUT #2,QuitMenuOpt$
  1269.       LINE INPUT #2,QuitMenus$
  1270.       CALL Graphic (GDefault$,ZFileName$)
  1271.       CALL BreakFileName (ZFileName$,MenuDrvPath$,WasX$,ZWasY$,ZTrue)
  1272.       MenuToDisplay$ = ZFileName$
  1273.       WasJ = INSTR(ZOrigCommands$,"?")
  1274.       IF WasJ < 1 THEN _
  1275.          WasX$ = "" _
  1276.       ELSE WasX$ = MID$(ZAllOpts$,WasJ,1)
  1277. 59458 IF ZExpertUser THEN _
  1278.          GOTO 59461
  1279. 59460 ZNonStop = (ZPageLength < 1)
  1280.       CALL BufFile (MenuToDisplay$,WasX)
  1281. 59461 ZOutTxt$ = Prompt$
  1282.       ZTurboKey = -ZTurboKeyUser
  1283.       CALL PopCmdStack
  1284.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1285.          EXIT SUB
  1286.       IF ZWasQ = 0 THEN _
  1287.          GOTO 59458
  1288. 59462 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1289.       CALL AllCaps (ZWasZ$)
  1290.       WasJ = INSTR(ValidChoice$,ZWasZ$)
  1291.       IF WasJ < 1 THEN _
  1292.          GOTO 59492
  1293.       ZWasZ$ = MID$(ActualCommands$,WasJ,1)
  1294.       ZUserIn$(ZAnsIndex) = ZWasZ$
  1295.       WasJ = INSTR(MenuChoice$,ZWasZ$)
  1296.       IF WasJ > 0 THEN _
  1297.          ZCurPUI$ = MID$(MenuName$,1 + (WasJ - 1) * 7,7) : _
  1298.          GOTO 59490
  1299.       IF ZWasZ$ = WasX$ THEN _
  1300.          GOTO 59460
  1301.       IF ZWasZ$ <> QuitCmd$ THEN _
  1302.          EXIT SUB
  1303. 59470 ZOutTxt$ = QuitPrompt$
  1304.       ZTurboKey = -ZTurboKeyUser
  1305.       CALL PopCmdStack
  1306.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1307.          EXIT SUB
  1308.       IF ZWasQ = 0 THEN _
  1309.          GOTO 59458
  1310. 59480 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1311.       CALL AllCaps (ZWasZ$)
  1312.       WasJ = INSTR(QuitSubCmds$,ZWasZ$)
  1313.       IF WasJ < 1 THEN _
  1314.          GOTO 59470
  1315.       WasJ = INSTR(QuitMenuOpt$,ZWasZ$)
  1316.       IF WasJ > 0 THEN _ 'quit to submenu
  1317.          ZCurPUI$ = MID$(QuitMenus$,1 + (WasJ - 1) * 7,7) : _
  1318.          GOTO 59490
  1319.       ZUserIn$(ZAnsIndex) = QuitCmd$ 'valid but not menu-send to RBBS
  1320.       EXIT SUB
  1321. 59490 CALL Remove (ZCurPUI$," ")
  1322.       ZCurPUI$ = MenuDrvPath$ + _
  1323.                      ZCurPUI$ + _
  1324.                      ".PUI"
  1325.       GOTO 59455
  1326. 59492 CALL QuickTPut1 ("No such option <" + ZWasZ$ + ">")            ' DA071701
  1327.       Call FlushKeys                                                 ' KG081703
  1328.       GOTO 59460
  1329.       END SUB
  1330. 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus'
  1331. ' $PAGE
  1332. '
  1333. '  NAME    -- SubMenu
  1334. '
  1335. '  INPUTS  --   PARAMETER     MEANING
  1336. '             PassedPrompt$   PROMPT TO DISPLAY
  1337. '             CurMenu$        NOVICE MENU TO DISPLAY
  1338. '             FrontOpt$       DRIVE/PATH/PREFIX OF FILE
  1339. '                             NEEDED FOR TYPED OPTION
  1340. '             BackOpt$        SUFFIX/EXTENSION OF FILE
  1341. '                             NEEDED WITH TYPED OPTION
  1342. '             ReturnOn$       LETTERS CALLING PROGRAM WANTS
  1343. '                             CONTROL ON
  1344. '             GRDefault$      GRAPHICS DEFAULT TO USE
  1345. '             VerifyInMenu    WHETHER VERIFY OPTION IS IN MENU
  1346. '             AllMenuOK       WHETHER CONTROL SHOULD RETURN
  1347. '                             WHEN IN MENU
  1348. '             ZAnsIndex       # OF COMMANDS IN TYPE AHEAD
  1349. '             RequireInMenu   WHETHER OPTION MUST BE IN MENU
  1350. '
  1351. '  OUTPUTS -- ZWasZ$              OPTION PICKED
  1352. '             ZFileName$      NAME OF FILE SUPPORTING OPTION
  1353. '
  1354. '
  1355. '  PURPOSE -- Handles menus - including conference, bulletins,
  1356. '             doors, questionnaires.  Supports sub-menus (i.e.
  1357. '             an option on the menu that invokes another menu)
  1358. '
  1359.       SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _
  1360.                   BackOpt$,ReturnOn$,GRDefault$,PassedVerifyInMenu, _' KG082005
  1361.                   AllMenuOK,RequireInMenu,BackOpt2$,InMenu) STATIC   ' KG032502
  1362. 59510 ZFileName$ = CurMenu$
  1363.       InMenu = ZTrue                                                 ' KG041701
  1364.       CALL BreakFileName (FrontOpt$,WasX$,FrontPre$,ZWasDF$,ZTrue)   ' KG101101
  1365.       CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
  1366.       MenuFront$ = MenuDrv$ + LEFT$(WasX$,LEN(WasX$)-LEN(PreSuf$))   ' KG090801
  1367.       IF CurMenu$ = LastSubMenu$ THEN _                              ' KG090801
  1368.          MenuFront$ = LEFT$(MenuFront$,LEN(MenuFront$)-1)            ' KG090801
  1369.       CALL Graphic (GRDefault$,ZFileName$)
  1370.       CurMenuVer$ = ZFileName$
  1371.       ZStopInterrupts = ZFalse
  1372.       IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
  1373.          GOTO 59520
  1374. 59515 CALL BufFile (CurMenuVer$,ZAnsIndex) 'show menu
  1375. 59520 ZOutTxt$ = PassedPrompt$            'get response
  1376.       CALL PopCmdStack
  1377.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  1378.          EXIT SUB
  1379. 59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1380.       CALL AllCaps (ZWasZ$)
  1381.       IF INSTR(ReturnOn$,ZWasZ$) THEN _  'check whether calling pgm wants
  1382.          EXIT SUB
  1383.       IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
  1384.          GOTO 59515
  1385.       IF INSTR(ZWasZ$,".") > 0 THEN _
  1386.          GOTO 59532
  1387.       CALL BadFile (ZWasZ$,WasBF)                                    ' KG081705
  1388.       IF WasBF > 1 THEN _                                            ' KG081705
  1389.          GOTO 59532                                                  ' KG081705
  1390.       FPre$ = MenuFront$   ' check for sub-option                    ' KG081603
  1391.       PreSuf$ = "-"                                                  ' KG090801
  1392.       CALL BadFile (FPRE$ + ZWasZ$ + "-",WasBF)                      ' KG090801
  1393.       ZOK = ZFalse                                                   ' KG082401
  1394.       IF WasBF < 2 THEN _                                            ' KG082401
  1395.          VerifyInMenu = ZFalse : _                                   ' KG082401
  1396.          GOSUB 59538
  1397.       PreSuf$ = ""                                                   ' KG090801
  1398.       VerifyInMenu = PassedVerifyInMenu                              ' KG082005
  1399.       IF NOT ZOK THEN _                                              ' KG081603
  1400.          FPre$ = FrontOpt$ : _    ' check standard option            ' KG081603
  1401.          GOSUB 59538 : _
  1402.          IF NOT ZOK THEN _    ' check option where menu is           ' KG081603
  1403.             FPre$ = MenuDrv$ + FrontPre$ : _                         ' KG101101
  1404.             IF FrontOpt$ <> FPre$ THEN _                             ' KG101101
  1405.                GOSUB 59538                                           ' KG101101
  1406.       IF NewMenu THEN _
  1407.          NewMenu = ZFalse : _
  1408.          GOTO 59515
  1409.       IF ZOK THEN _
  1410.          EXIT SUB
  1411. 59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _                 ' KG102202
  1412.          ZWasZ$ = LEFT$(ZWasZ$,1) : _                                ' KG102202
  1413.          EXIT SUB
  1414.       GOSUB 59547
  1415.       GOTO 59515
  1416. 59538 FilName$ = FPre$ + ZWasZ$ + PreSuf$                            ' KG090801
  1417.       ZFileName$ = FilName$ + BackOpt$                               ' KG090801
  1418.       GOSUB 59543                                                    ' KG101201
  1419.       IF WasBF > 1 THEN _                                            ' KG101201
  1420.          ZOK = ZFalse : _                                            ' KG101201
  1421.          RETURN                                                      ' KG101201
  1422.       CALL Graphic (GRDefault$,ZFileName$)
  1423.       IF NOT ZOK THEN _
  1424.          IF BackOpt2$ <> "" THEN _
  1425.             ZFileName$ = FilName$ + _
  1426.                          BackOpt2$ : _
  1427.          GOSUB 59543 : _                                             ' KG101201
  1428.          IF WasBF > 1 THEN _                                         ' KG101201
  1429.             ZOK = ZFalse : _                                         ' KG101201
  1430.             RETURN _                                                 ' KG101201
  1431.          ELSE CALL Graphic (GRDefault$,ZFileName$)                   ' KG101201
  1432.       IF ZOK THEN _                                                  ' KG092301
  1433.          CALL WordInFile (CurMenu$,ZWasZ$,InMenu) : _                ' KG092301
  1434.          IF ZSysop OR InMenu OR (NOT RequireInMenu) THEN _           ' KG092301
  1435.             RETURN _
  1436.          ELSE GOTO 59540
  1437.       IF (NOT VerifyInMenu) THEN _
  1438.          GOTO 59540
  1439.       CALL WordInFile (CurMenu$,ZWasZ$,InMenu)  'verify against menu itself ' KG032502
  1440.       IF InMenu THEN _                                               ' KG032502
  1441.          IF AllMenuOK THEN _
  1442.             RETURN
  1443. 59540 WasX$ = FPre$ + _
  1444.            ZWasZ$ + PreSuf$ + _                                      ' KG090801
  1445.            ".MNU" 'check whether option is a menu
  1446.       ZFileName$ = WasX$
  1447.       CALL Graphic (GRDefault$,ZFileName$)
  1448.       IF ZOK THEN _
  1449.          NewMenu = ZTrue : _
  1450.          CurMenuVer$ = ZFileName$ : _
  1451.          CurMenu$ = WasX$ : _
  1452.          CALL BreakFileName (FPre$ + ZWasZ$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _ ' KG090801
  1453.          MenuFront$ = MenuDrv$ + WasX$ : _                           ' KG090801
  1454.          IF PreSuf$ = "-" THEN _                                     ' KG090801
  1455.             LastSubMenu$ = CurMenu$                                  ' KG090801
  1456.       RETURN
  1457. 59543 WasZ$ = ZWasZ$                                                 ' KG101201
  1458.       CALL BadName (WasBF,ZFalse)                                    ' KG101201
  1459.       ZWasZ$ = WasZ$                                                 ' KG101201
  1460.       RETURN                                                         ' KG101201
  1461. 59547 CALL QuickTPut1 ("No such option " + ZWasZ$)
  1462.       ZLastIndex = 0
  1463.       IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _        ' KG082005
  1464.          CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _          ' KG082005
  1465.                        CurMenu$ + " but not found",1)                ' KG082005
  1466.       RETURN
  1467. 59548 END SUB
  1468. 59600 ' $SUBTITLE: 'SetEcho -- subroutine to reset who echoes'
  1469. ' $PAGE
  1470. '
  1471. '  NAME    -- SetEcho
  1472. '
  1473. '  INPUTS  --   PARAMETER     MEANING
  1474. '               NewEcho$   The new echo option
  1475. '               ZLocalUser
  1476. '
  1477. '  OUTPUTS -- ZRemoteEcho   Whether RBBS is to echo what a
  1478. '                           remote caller types
  1479. '
  1480. '  PURPOSE -- Resets who echos.  "R" is for RBBS to echo.
  1481. '             "I" is for intermediate host to echo.
  1482. '             "C" is for caller's communication pgm to echo.
  1483. '
  1484.       SUB SetEcho (NewEcho$) STATIC
  1485.       IF NewEcho$ = PrevEcho$ THEN _
  1486.          EXIT SUB
  1487.       IF NewEcho$ = "R" THEN _
  1488.          ZRemoteEcho = (NOT ZLocalUser) _
  1489.       ELSE ZRemoteEcho = ZFalse
  1490.       IF ZLocalUser THEN _
  1491.          GOTO 59602
  1492.       IF NewEcho$ = "I" THEN _
  1493.           IF ZFossil THEN _
  1494.              Bytes = LEN(ZHostEchoOn$) : _
  1495.              CALL FosWrite(ZComPort,Bytes,ZHostEchoOn$) : _
  1496.              GOTO 59602 _
  1497.           ELSE PRINT #3,ZHostEchoOn$; : _
  1498.                GOTO 59602
  1499.       IF PrevEcho$ = "I" THEN _
  1500.           IF ZFossil THEN _
  1501.              Bytes = LEN(ZHostEchoOff$) : _
  1502.              CALL FosWrite(ZComPort,Bytes,ZHostEchoOff$) _
  1503.           ELSE PRINT #3,ZHostEchoOff$;
  1504. 59602 PrevEcho$ = NewEcho$
  1505.       END SUB
  1506. 59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
  1507. ' $PAGE
  1508. '
  1509. '  NAME    -- MsgImport
  1510. '
  1511. '  INPUTS  --   PARAMETER     MEANING
  1512. '               MaxLines     MAXIMUM # OF LINES
  1513. '               MaxLen       MAXIMUM LENGTH OF A LINE
  1514. '               NumLines     NUMBER OF LINES ALREADY IN MESSAGE
  1515. '               LineAra$     ARRAY OF LINES IN MESSAGE
  1516. '
  1517. '  OUTPUTS --   NumLines
  1518. '               LineAra$
  1519. '
  1520. '  PURPOSE -- Allows local user to append a text file to
  1521. '             a message.   Will word wrap if needed.
  1522. '
  1523.       SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
  1524.       IF NOT (ZLocalUser OR ZSysop) THEN _
  1525.          CALL QuickTPut1 ("Only for SYSOPS/local users") : _
  1526.          EXIT SUB
  1527. 59700 ZOutTxt$ = "Import what file" + ZPressEnter$
  1528.       CALL PopCmdStack
  1529.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1530.          EXIT SUB
  1531.       CALL FindIt (ZUserIn$(ZAnsIndex))
  1532.       IF NOT ZOK THEN _
  1533.          CALL QuickTPut1 (ZUserIn$(ZAnsIndex) + " not found") : _
  1534.          GOTO 59700
  1535.       WHILE NOT EOF(2) AND NumLines < MaxLines
  1536.          NumLines = NumLines + 1
  1537.          LINE INPUT #2,LineAra$(NumLines)
  1538.       WEND
  1539.       CLOSE 2
  1540.       CALL WordWrap (MaxLen,NumLines,LineAra$())
  1541.       END SUB
  1542. 59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message'
  1543. ' $PAGE
  1544. '
  1545. '  NAME    -- WordWrap
  1546. '
  1547. '  INPUTS  --   PARAMETER     MEANING
  1548. '               MaxLen       MAXIMUM LENGTH OF A SINGLE LINE
  1549. '               NumLines     NUMBER OF LINES IN A MESSAGE
  1550. '               LineAra$     ALL THE LINES IN THE MESSAGE
  1551. '
  1552. '  OUTPUTS --   NumLines
  1553. '               LineAra$
  1554. '
  1555. '  PURPOSE -- Batch adjusts a message, wrapping lines if
  1556. '             needed.  Preserves paragraph structure.
  1557. '
  1558.       SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC
  1559.       WasJ = 1
  1560.       WHILE WasJ <= NumLines
  1561.          ReFormatted = ZFalse
  1562. 59704    CALL TrimTrail (LineAra$(WasJ)," ")
  1563.          WasK = LEN(LineAra$(WasJ))
  1564.          IF WasK <= MaxLen THEN _
  1565.             GOTO 59705
  1566.          CALL FindLast (LineAra$(WasJ)," ",LastPos,HowMany)
  1567.          CALL AnyBut (LineAra$(WasJ),1,">",WasX)
  1568.          CALL AnyBut (LineAra$(WasJ+1),1,">",Temp)
  1569.          IF LEFT$(LineAra$(WasJ + 1),2) = "  " OR ((Temp > 0) AND WasX <> Temp) THEN _
  1570.             FOR WasK = NumLines TO WasJ + 1 STEP -1 : _
  1571.                LineAra$(WasK + 1) = LineAra$(WasK) : _
  1572.             NEXT : _
  1573.             NumLines = NumLines + 1 : _
  1574.             LineAra$(WasJ + 1) = ""
  1575.          IF WasX > 1 THEN _
  1576.             IF MID$(LineAra$(WasJ),WasX,1) = " " THEN _
  1577.                WasX = WasX + 1
  1578.          WasX$ = LEFT$(LineAra$(WasJ),WasX-1)
  1579.          IF LastPos < 1 THEN _
  1580.             LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),MaxLen) + MID$(LineAra$(WasJ + 1),WasX) : _
  1581.             LineAra$(WasJ) = LEFT$(LineAra$(WasJ),MaxLen - 1) + "-" _
  1582.          ELSE ZUserIn$ = LEFT$(" ", - (LEN(LineAra$(WasJ + 1)) > 0)) : _
  1583.               LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),LastPos + 1) + ZUserIn$ + MID$(LineAra$(WasJ + 1),WasX) : _
  1584.               LineAra$(WasJ) = LEFT$(LineAra$(WasJ),LastPos - 1)
  1585.          ReFormatted = ZTrue
  1586.          GOTO 59704
  1587. 59705    IF ReFormatted THEN _
  1588.             IF WasJ = NumLines THEN _
  1589.                NumLines = NumLines + 1
  1590.          WasJ = WasJ + 1
  1591.       WEND
  1592.       END SUB
  1593. 59760 ' $SUBTITLE: 'AnyBut -- subroutine to find where a word begins'
  1594. ' $PAGE
  1595. '
  1596. '  NAME    -- AnyBut
  1597. '
  1598. '  INPUTS  --   PARAMETER     MEANING
  1599. '               Strng$        STRING TO SEARCH FOR WORDS
  1600. '               Beg           BYTE POSITION IN Strng$ TO
  1601. '                             BEGIN SEARCHING
  1602. '               SkipChars$    CHARACTERS TO SKIP OVER WHEN
  1603. '                                SEARCHING
  1604. '
  1605. '  OUTPUTS --   WhereIs      BYTES POSITION IN Strng$ WHERE
  1606. '                             WORD BEGINS
  1607. '
  1608. '  PURPOSE -- Parser.   Finds where a "word" begins, where
  1609. '             any character will be accepted as the beginning of a
  1610. '             word except those listed in SKIP.CHAR$
  1611. '
  1612.       SUB AnyBut (Strng$, Beg, SkipChars$, WhereIs) STATIC
  1613.       WasX$ = Strng$ + _
  1614.            CHR$(0)
  1615.       WhereIs = Beg
  1616.       IF WhereIs < 1 THEN _
  1617.          WhereIs = 1
  1618.       WHILE INSTR(SkipChars$, MID$(WasX$, WhereIs, 1)) > 0
  1619.          WhereIs = WhereIs + 1
  1620.       WEND
  1621.       IF WhereIs > LEN(Strng$) THEN _
  1622.          WhereIs = 0
  1623.       END SUB
  1624. 59770 ' $SUBTITLE: 'FindEnd -- subroutine to find where a word ends'
  1625. ' $PAGE
  1626. '
  1627. '  NAME    -- FindEnd
  1628. '
  1629. '  INPUTS  --   PARAMETER     MEANING
  1630. '               Strng$        STRING TO SEARCH FOR WORDS
  1631. '               Beg          POSITION IN Strng$ TO BEGIN SEARCH
  1632. '               StopWith$    CHARACTERS THAT TERMINATE A WORD
  1633. '
  1634. '  OUTPUTS      WhereIs      POSITION IN Strng$ WHERE WORD ENDS
  1635. '                             (I.E. THE Last CHARACTER OF THE WORD)
  1636. '
  1637. '  PURPOSE -- Parser.   Finds where a "word" ends, where
  1638. '             any character will be counted as in a word
  1639. '             except for those in StopWith$ or when the end of
  1640. '             the string is found.
  1641. '
  1642.       SUB FindEnd (Strng$, Beg, StopWith$, WhereIs) STATIC
  1643.       ZWasB = Beg
  1644.       IF ZWasB < 1 THEN _
  1645.          ZWasB = 1
  1646.       IF ZWasB > LEN(Strng$) THEN _
  1647.          WasX$ = StopWith$ _
  1648.       ELSE WasX$ = MID$(Strng$, ZWasB) + _
  1649.                 StopWith$
  1650.       WasI = 1
  1651.       WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1652.       WHILE WasX = 0
  1653.          WasI = WasI + 1
  1654.          WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1655.       WEND
  1656.       WhereIs = WasI - 1 + ZWasB - 1
  1657.       END SUB
  1658. 59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
  1659. ' $PAGE
  1660. '
  1661. '  NAME    -- GetAll
  1662. '
  1663. '  INPUTS  --   PARAMETER     MEANING
  1664. '               LookIn$       NAME OF FILE TO SEARCH
  1665. '               DIR.EXT$      MAIN DIRECTORY EXTENSION TO USE
  1666. '               StartPos      Last POSITION USED IN ARRAY
  1667. '
  1668. '  OUTPUTS      StartPos     Last ELEMENT USED IN ARRAY
  1669. '               LoadInto$    ARRAY TO LOAD ELEMENTS Found
  1670. '
  1671. '  PURPOSE -- Creates a list (LoadInto$) of all directories
  1672. '             to be listed when ZWasA)ll is selected for a directory.
  1673. '             All uses config parm, which can be either a single
  1674. '             directory or list of directories (begin with "@").
  1675. '
  1676.       SUB GetAll (LoadInto$(1), StartPos) STATIC
  1677.       IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
  1678.          StartPos = StartPos + 1 : _
  1679.          LoadInto$(StartPos) = ZMasterDirName$ : _
  1680.          EXIT SUB
  1681.       ZOK = ZFalse
  1682.       IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
  1683.          CALL FindIt(MID$(ZMasterDirName$,2))
  1684.       IF NOT ZOK THEN _
  1685.          CALL QuickTPut1 ("No dirs defined for A)ll") : _
  1686.          EXIT SUB
  1687.       MaxLoad = UBOUND(LoadInto$, 1)
  1688.       StartSort = StartPos + 1
  1689.       WHILE NOT EOF(2) AND StartPos < MaxLoad
  1690.          LINE INPUT #2, ZOutTxt$
  1691.          StartPos = StartPos + 1
  1692.          LoadInto$(StartPos) = ZOutTxt$
  1693.       WEND
  1694.       CLOSE 2
  1695.       END SUB
  1696. 59800 ' $SUBTITLE: 'BadFileChar -- checks file for illegal char'
  1697. ' $PAGE
  1698. '
  1699. '  NAME    --  BadFileChar
  1700. '
  1701. '  INPUTS  --  PARAMETER         MEANING
  1702. '               FilName$         NAME OF FILE TO CHECK
  1703. '
  1704. '  OUTPUTS --  IsOK            WHETHER NAME OK
  1705. '
  1706. '  PURPOSE --  Part of test for file's existence.  If bad
  1707. '              character in name, can't exist.
  1708. '
  1709.       SUB BadFileChar (FilName$,IsOK) STATIC
  1710.       WasL = LEN(FilName$)
  1711.       IF WasL > 2 THEN _
  1712.          IF INSTR(3,FilName$,":") > 0 THEN _
  1713.             IsOK = ZFalse : _
  1714.             EXIT SUB
  1715.       WasX$ = FilName$ + "="
  1716.       WasI = 1
  1717.       WHILE INSTR("/[]|<>+=;, ?*",MID$(WasX$,WasI,1)) = 0 AND ASC(MID$(WasX$,WasI)) < 128
  1718.          WasI = WasI + 1
  1719.       WEND
  1720.       IsOK = WasI > WasL
  1721.       END SUB
  1722. '
  1723. 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
  1724. ' $PAGE
  1725. '
  1726. '  NAME    -- ConfMail
  1727. '
  1728. '  INPUTS  -- PARAMETER        MEANING
  1729. '         SKIP.CONFIRM         Whether to skip confirm of option
  1730. '         ZConfMailList$       File of user/message pairs to check
  1731. '         ZActiveUserFile$     Active user file (restored on exit)
  1732. '         ZActiveMessageFile$  Active msg file (restored)
  1733. '  OUTPUTS -- None
  1734. '
  1735. '  PURPOSE -- Quicking scans message header record to get
  1736. '             last msg # and user record to get whether any
  1737. '             new mail and last msg read, reports both, using
  1738. '             highlighting if new mail to caller.
  1739. '
  1740.       SUB ConfMail (MailCheckConfirm) STATIC
  1741.       SkipJoinUnjoin = ZNonStop
  1742.       IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
  1743.          CALL FindIt (ZConfMailList$) _
  1744.       ELSE ZOK = ZFalse
  1745.       IF NOT ZOK THEN _
  1746.          EXIT SUB
  1747.       IF PrevMailList$ <> ZConfMailList$ THEN _                      ' KG072101
  1748.          SkipParms = 0                                               ' KG072101
  1749.       PrevMailList$ = ZConfMailList$                                 ' KG072101
  1750.       IF MailCheckConfirm THEN _
  1751.          ZOutTxt$ = "Check conferences for mail ([Y],N)" : _
  1752.          ZTurboKey = -ZTurboKeyUser : _
  1753.          CALL PopCmdStack : _
  1754.          IF ZNo OR ZSubParm < 0 THEN _
  1755.             EXIT SUB
  1756.       CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
  1757.       CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
  1758.       CALL SkipLine (1)
  1759.       CALL QuickTPut1 ("Checking Message Bases...")                  ' DA071701
  1760.       AnyMail = ZFalse
  1761.       ZStopInterrupts = ZFalse
  1762.       WasA1$ = ZActiveUserFile$
  1763.       MsgFileSave$ = ZActiveMessageFile$
  1764.       TempIndivValue$ = ""
  1765.       UserFileIndexSave = ZUserFileIndex
  1766.       UserRecordHold$ = ZUserRecord$
  1767.       ZOK = ZTrue
  1768.       CALL ReadParms (ZWorkAra$(),1,SkipParms)                       ' KG072101
  1769.       IF SkipParms = 0 THEN _                                        ' KG072101
  1770.          LogicalEOF$ = "" _                                          ' KG072101
  1771.       ELSE LogicalEOF$ = ZWorkAra$(1)                                ' KG072101
  1772. 59852 IF NOT ZOK THEN _
  1773.          GOTO 59854 _                                                ' KG072101
  1774.       ELSE IF EOF(2) THEN _                                          ' KG072101
  1775.               IF LogicalEOF$ = "" OR SkipParms = 0 THEN _            ' KG073104
  1776.                  GOTO 59854 _                                        ' KG072101
  1777.               ELSE CALL FindIt (ZConfMailList$) : _                  ' KG072101
  1778.                    SkipParms = 0 : _                                 ' KG072901
  1779.                    GOTO 59852                                        ' KG072101
  1780.          CALL ReadAny
  1781.          ZActiveUserFile$ = ZOutTxt$
  1782.          CALL ReadAny
  1783.          IF ZErrCode > 0 THEN _
  1784.             GOTO 59854
  1785.          SkipParms = SkipParms + 2                                   ' KG080701
  1786.          ZActiveMessageFile$ = ZOutTxt$                              ' KG072901
  1787.          CALL FindFile (ZActiveUserFile$,ZOK)
  1788.          IF NOT ZOK THEN _
  1789.             GOTO 59854
  1790.          CALL OpenUser (HighestUserRecord)
  1791.          FIELD 5, 128 AS ZUserRecord$
  1792.          CALL FindFile (ZActiveMessageFile$,ZOK)
  1793.          IF NOT ZOK THEN _
  1794.             GOTO 59854
  1795.          CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
  1796.                         0,0,HighestUserRecord,_
  1797.                         Found,HoldUserFileIndex,ZWasSL)
  1798.          IF NOT Found THEN _
  1799.             GOTO 59853                                               ' KG080701
  1800.          CALL OpenMsg
  1801.          FIELD 1, 128 AS ZMsgRec$
  1802.          GET 1,1
  1803.          AnyMail = ZTrue
  1804.          WasX = CVI(MID$(ZUserRecord$,57,2))
  1805.          WasX = (WasX AND 512) > 0
  1806.          CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
  1807.          InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
  1808.          IF InCur THEN _
  1809.             WasX = ZMailWaiting : _                                  ' KG030101
  1810.             ZWasA = ZLastMsgRead _
  1811.          ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
  1812.          ZWasB = VAL(LEFT$(ZMsgRec$,8))
  1813.          WasZ = (ZWasB - ZWasA)
  1814.          IF WasZ < 0 THEN _
  1815.             ZWasA = 0 : _
  1816.             WasZ = ZWasB _
  1817.          ELSE IF WasZ = 0 THEN _
  1818.                  WasX = ZFalse
  1819.          ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
  1820.          ZWasSL = LEN(ZOutTxt$)
  1821.          ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$
  1822.          ZWasSL = LEN(CurPre$)
  1823.          IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
  1824.             Conf$ = "MAIN" _
  1825.          ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
  1826.          ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
  1827.          IF WasX THEN _
  1828.             WasX$ = ZEmphasizeOn$ + "*Some* to you" + ZEmphasizeOff$ _ ' KG081405
  1829.          ELSE WasX$ = ""                                             ' KG081405
  1830.          ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s) " + _ ' KG081405
  1831.               WasX$                                                  ' KG081405
  1832.          ZSubParm = 5
  1833.          CALL TPut
  1834.          ZJumpSupported = ZFalse                                     ' DA080901
  1835.          IF SkipJoinUnjoin THEN _
  1836.             CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
  1837.             GOTO 59853                                               ' KG080701
  1838.          ZTurboKey = -ZTurboKeyUser
  1839.          CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse)
  1840.          IF ZNo THEN _
  1841.             GOTO 59854
  1842.          WasX$ = LEFT$(ZUserIn$(1),1)
  1843.          CALL AllCaps (WasX$)
  1844.          IF WasX$ = "J" THEN _
  1845.             ZHomeConf$ = Conf$ : _
  1846.             GOTO 59854
  1847.          IF WasX$ = "U" THEN _
  1848.             IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
  1849.                CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _
  1850.             ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
  1851.                  ZUserFileIndex = HoldUserFileIndex : _
  1852.                  ZSubParm = 6 : _
  1853.                  CALL FileLock : _
  1854.                  PUT 5, HoldUserFileIndex : _
  1855.                  ZSubParm = 8 : _
  1856.                  CALL FileLock : _
  1857.                  CALL QuickTPut1 ("Omitted you from " + Conf$)       ' KG073104
  1858. 59853 IF ZActiveMessageFile$ = LogicalEOF$ THEN _                    ' KG073104
  1859.          GOTO 59854                                                  ' KG073104
  1860.       IF NOT ZRet THEN _                                             ' KG073104
  1861.          GOTO 59852                                                  ' KG080701
  1862. 59854 ZActiveUserFile$ = WasA1$
  1863.       CALL OpenUser (HighestUserRecord)
  1864.       FIELD 5, 128 AS ZUserRecord$
  1865.       IF (NOT ZRet) AND NOT AnyMail THEN _
  1866.          CALL QuickTPut1 ("You have not joined any conferences")
  1867.       ZUserFileIndex = UserFileIndexSave
  1868.       LSET ZUserRecord$ = UserRecordHold$
  1869.       ZActiveMessageFile$ = MsgFileSave$
  1870.       CALL OpenMsg
  1871.       FIELD 1, 128 AS ZMsgRec$
  1872.       GET 1,1
  1873.       ZNonStop = (ZPageLength > 0)
  1874.       WasX$ = ZUserIn$(ZAnsIndex+1)                                  ' KG071202
  1875.       CALL AllCaps (WasX$)                                           ' KG071202
  1876.       ZAnsIndex = ZAnsIndex - (WasX$ = "C")                          ' KG071202
  1877.       SkipParms = -(NOT EOF(2))*SkipParms                            ' KG072101
  1878.       END SUB
  1879. 59858 ' $SUBTITLE: 'AskMore -- pauses when possible screen full'
  1880. ' $PAGE
  1881. '
  1882. '  NAME    -- AskMore
  1883. '
  1884. '  INPUTS  --   PARAMETER     MEANING
  1885. '               ExtraPrompt$  STRING TO ADD TO MORE PROMPT AT END
  1886. '               OverWrite     WHETHER TO WIPE AWAY PROMPT
  1887. '
  1888. '  OUTPUTS --   ZUserIn$()
  1889. '               ZNo
  1890. '
  1891. '  PURPOSE -- Determines whether need to pause if screen full.
  1892. '             And, if so, asks the appropriate question.  If non-
  1893. '             stop, at least check for carrier present.
  1894. '
  1895.       SUB AskMore (ExtraPrompt$, OverWrite, CheckLines,AbortIndex,CantInterrupt) STATIC
  1896.       ZNo = ZFalse
  1897.       IF CheckLines THEN _
  1898.          WasX = -ZDisplayAsUnit*ZUnitCount -(NOT ZDisplayAsUnit)*ZLinesPrinted : _
  1899.          IF WasX < ZPageLength OR (ZPageLength = 0) THEN _
  1900.             ZWasQ = 0 : _
  1901.             EXIT SUB
  1902.       IF ZOneStop THEN _
  1903.          ZOneStop = ZFalse : _
  1904.          ZNonStop = ZTrue : _
  1905.          GOTO 59860
  1906.       IF ZNonStop THEN _
  1907.          ZLinesPrinted = 0 : _
  1908.          CALL CheckCarrier : _
  1909.          IF ZKeyboardStack$ = "" AND ZCommPortStack$ = "" THEN _
  1910.             EXIT SUB _
  1911.          ELSE ZNonStop = ZFalse
  1912. 59860 CALL QuickTPut (ZEmphasizeOff$,0)
  1913.       IF CantInterrupt THEN _
  1914.          ZTurboKey = 2 : _
  1915.          ZForceKeyboard = ZTrue : _
  1916.          ZOutTxt$ = "Press Any Key to continue" _
  1917.       ELSE GOSUB 59870 : _
  1918.            ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
  1919.       WasX = LEN(ZOutTxt$) + 2
  1920.       ZNoAdvance = OverWrite
  1921.       ZSubParm = 1
  1922.       IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
  1923.          ZTurboKey = -ZTurboKeyUser
  1924.       ZMacroMin = 2
  1925.       CALL TGet
  1926.       IF ZSubParm = -1 THEN _
  1927.         EXIT SUB
  1928.       ZTurboKey = ZFalse
  1929.       ZWasDF$ = ZUserIn$ (1)
  1930.       CALL AllCaps (ZWasDF$)
  1931.       WasI = INSTR(";C;A;",";"+ZWasDF$+";")
  1932.       IF WasI = 1 THEN _
  1933.          ZNonStop = ZTrue : _
  1934.          ZWasQ = 0
  1935.       CALL WipeLine (WasX + LEN(ZUserIn$))
  1936.       IF NOT ZHiLiteOff THEN _
  1937.          CALL QuickTPut (ZLastSmartColor$,0)
  1938.       IF CantInterrupt THEN _
  1939.          ZNo = ZFalse : _
  1940.          EXIT SUB
  1941.       IF WasI = 3 THEN _
  1942.          AbortIndex = 32000
  1943.       IF ZNo THEN _
  1944.          ZKeyboardStack$ = "" : _
  1945.          ZCommPortStack$ = "" : _
  1946.          ZLastSmartColor$ = ""
  1947.       IF NOT ZJumpSupported THEN _
  1948.          EXIT SUB
  1949.       IF ZWasDF$ = "J" THEN _
  1950.          IF ZWasQ > 1 THEN _
  1951.             ZUserIn$ = ZUserIn$(2) : _
  1952.             GOTO 59866 _
  1953.          ELSE ZOutTxt$ = "Jump to what text" + ZPressEnterExpert$ : _
  1954.               CALL PopCmdStack : _
  1955.               IF ZWasQ = 0 THEN _
  1956.                  EXIT SUB _
  1957.               ELSE GOTO 59866
  1958.       IF ZWasDF$ <> "R" THEN _
  1959.          EXIT SUB
  1960.       ZUserIn$ = ZJumpLast$
  1961. 59866 ZJumpTo$ = ZUserIn$
  1962.       CALL AllCaps (ZJumpTo$)
  1963.       ZJumpSearching = ZTrue
  1964.       ZJumpLast$ = ZJumpTo$
  1965.       EXIT SUB
  1966. 59870 Temp$ = ""
  1967.       IF NOT ZJumpSupported THEN _
  1968.          RETURN
  1969.       IF ZJumpLast$ = "" THEN _
  1970.          Temp$ = LEFT$(",J)ump",2+4*(ZExpertUser+1)) _
  1971.       ELSE IF ZExpertUser THEN _
  1972.               Temp$ = ",J,R=" + ZJumpLast$ _
  1973.            ELSE Temp$ = ",J)ump,R)ejump=" + ZJumpLast$
  1974.       RETURN
  1975.       END SUB
  1976. 59880 ' $SUBTITLE: 'CompDate -- subroutine to compute elased days'
  1977. ' $PAGE
  1978. '
  1979. '  NAME    -- CompDate
  1980. '
  1981. '  INPUTS  --   PARAMETER     MEANING
  1982. '                   Year        YEAR
  1983. '                   WasMM       MONTH
  1984. '                   WasDD       DAY
  1985. '                 Result!    LOCATION TO PLACE THE Result
  1986. '
  1987. '  OUTPUTS -- Result!        COMPUTE COMPUTATIONAL DATE
  1988. '
  1989. '  PURPOSE -- Computes a computational date from YEAR, MONTH, DAY.
  1990. '             Results may be used to compute the number of elapsed
  1991. '             days between two dates.  You may pass a 2 or 4 digit
  1992. '             year, but for meaningful results, be consistent
  1993. '
  1994.       SUB CompDate (Year,WasMM,WasDD,Result!) STATIC
  1995.       IF WasMM < 1 OR WasMM > 12 THEN _
  1996.          WasMM = 1
  1997.       Result! = Year * 365.0 + _
  1998.                 INT((Year - 1) / 4) + _
  1999.                 (WasMM - 1) * 28 + _
  2000.                 VAL(MID$("000303060811131619212426",(WasMM - 1) * 2 + 1,2)) - _
  2001.                 ((WasMM > 2) AND ((Year MOD 4) = 0)) + _
  2002.                 WasDD
  2003.       END SUB
  2004. 59890 ' $SUBTITLE: 'ExpireDate -- subroutine to display expiration date'
  2005. ' $PAGE
  2006. '
  2007. '  NAME    -- ExpireDate
  2008. '
  2009. '  INPUTS  --   PARAMETER           MEANING
  2010. '             RegDate!    COMPUTATIONAL REGISTRATION DATE
  2011. '             RegPeriod   DAYS IN REGISTRATION PERIOD
  2012. '
  2013. '  OUTPUTS -- ExpDate$             DISPLAYABLE EXPIRATION DATE
  2014. '
  2015. '  PURPOSE -- Computes/creates a displayable registration
  2016. '             expiration date using registration date and days in
  2017. '             registration period.
  2018. '
  2019.       SUB ExpireDate (RegDate!,RegPeriod,ExpDate$) STATIC
  2020.       ExpDate! = RegDate! + RegPeriod
  2021.       ExpireYear = INT((ExpDate! - ExpDate! / 1461) / 365)
  2022.       ExpireDay = ExpDate! - (ExpireYear * 365.0 + INT((ExpireYear -1)/4))
  2023.       ExpireMonth = -((ExpireYear MOD 4)<>0) * _
  2024.                       (1 - (ExpireDay > 31) - (ExpireDay > 59) - _
  2025.                       (ExpireDay > 90) - (ExpireDay >120) - _
  2026.                       (ExpireDay > 151) - (ExpireDay > 181) - _
  2027.                       (ExpireDay > 212) - (ExpireDay > 243) - _
  2028.                       (ExpireDay > 273) - (ExpireDay > 304) - _
  2029.                       (ExpireDay > 334)) - ((ExpireYear MOD 4) = 0) * _
  2030.                       (1 - (ExpireDay > 31) - (ExpireDay > 60) - _
  2031.                       (ExpireDay > 91) - (ExpireDay >121) - _
  2032.                       (ExpireDay > 152) - (ExpireDay > 182) - _
  2033.                       (ExpireDay > 213) - (ExpireDay > 243) - _
  2034.                       (ExpireDay > 274) - (ExpireDay > 305) - _
  2035.                       (ExpireDay > 335))
  2036.       ExpireDay = (ExpireDay - ((ExpireMonth - 1) * 28 + _
  2037.          VAL(MID$("000303060811131619212426",(ExpireMonth -1) * 2 + 1,2)))) + _
  2038.          ((ExpireMonth > 2) AND ((ExpireYear MOD 4) = 0))
  2039.       ExpDate$ = RIGHT$("0" + MID$(STR$(ExpireMonth),2),2) + _
  2040.                   "/" + _
  2041.                   RIGHT$("0" + MID$(STR$(ExpireDay),2),2) + _
  2042.                   "/" + _
  2043.                   RIGHT$(STR$(ExpireYear),2)
  2044.       END SUB
  2045. 59920 ' $SUBTITLE: 'ColorDir - builds a color FMS directory string'
  2046. ' $PAGE
  2047. '
  2048. '  NAME    --  ColorDir
  2049. '
  2050. '  INPUTS  --  PARAMETER                   MEANING
  2051. '               Strng$              String to alter
  2052. '               FMSDir$            "Y" FOR FMS DIR
  2053. '                                  "N" FOR PERSONAL Download
  2054. '
  2055.       SUB ColorDir (Strng$,FMSDir$) STATIC
  2056.       IF ZWasGR < 2 THEN _
  2057.          EXIT SUB
  2058.       IF FMSDir$ = "N" THEN _
  2059.          GOTO 59921
  2060. '
  2061. ' INSERT COLOR FOR FILENAME
  2062. '
  2063.       ON INSTR("\ *",LEFT$(Strng$,1)) GOTO 59924,59922,59923
  2064. 59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _
  2065.                ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen)
  2066.       EXIT SUB
  2067. 59922 Strng$ = ZDR4$ + Strng$
  2068.       EXIT SUB
  2069. 59923 Strng$ = ZEmphasizeOff$ + Strng$
  2070. 59924 END SUB
  2071. 59930 ' $SUBTITLE: 'CheckColor - highlights based on search string'
  2072. ' $PAGE
  2073. '
  2074. '  NAME    --  CheckColor
  2075. '
  2076. '  INPUTS  --  PARAMETER                   MEANING
  2077. '              LookFor$           String that triggers highlight
  2078. '              LookIn$            String being searched
  2079. '              EndColor$          Terminating color
  2080. '
  2081. '  OUTPUTS --  Strng$              Revised string
  2082. '
  2083. '  PURPOSE --  Adds highlighting to a string within a string.
  2084. '              Respects previous colorization.
  2085.       SUB CheckColor (LookIn$,LookFor$,PassedEndColor$) STATIC
  2086.       IF LookFor$ = "" THEN _
  2087.          EXIT SUB
  2088.       WasX$ = LookIn$
  2089.       CALL AllCaps (WasX$)
  2090.       StartColor = INSTR(WasX$,LookFor$)
  2091.       IF StartColor < 1 THEN _
  2092.          EXIT SUB
  2093.       EndColor$ = PassedEndColor$
  2094.       IF EndColor$ = "" THEN _
  2095.          EndColor$ = ZEmphasizeOff$ : _
  2096.          CALL FindLast (LEFT$(LookIn$,StartColor-1),ZEscape$,WhereFound,WasJ) : _
  2097.          IF WhereFound > 0 THEN _
  2098.             WasJ = INSTR(WhereFound,LookIn$,"m") : _
  2099.             IF WasJ > 0 THEN _
  2100.                EndColor$ = MID$(LookIn$,WhereFound,WasJ-WhereFound+1)
  2101.       CALL Bracket (LookIn$,StartColor,StartColor + LEN(LookFor$)-1,ZEmphasizeOn$,EndColor$)
  2102.       END SUB
  2103. 59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference'
  2104. ' $PAGE
  2105. '
  2106. '  NAME    --  SetHiLite
  2107. '
  2108. '  INPUTS  --  PARAMETER                   MEANING
  2109. '              SetTo              New value (True or False)
  2110. '              ZEmphasizeOnDef$   String turns emphasize on
  2111. '              ZEmphasizeOffDef$  String turns emphasize off
  2112. '
  2113. '  OUTPUTS --  ZHiLiteOff       Callers preference on Hilite
  2114. '              ZEmphasizeOn$       String to use for emphasis
  2115. '              ZEmphasizeOff$      String to use after emphasis
  2116. '
  2117.       SUB SetHiLite (SetTo) STATIC
  2118.       ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo)
  2119.       IF ZHiLiteOff THEN _
  2120.          ZEmphasizeOn$ = "" : _
  2121.          ZEmphasizeOff$ = "" : _
  2122.          ZFG1$ = "" : _
  2123.          ZFG2$ = "" : _
  2124.          ZFG3$ = "" : _
  2125.          ZFG4$ = "" _
  2126.       ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _
  2127.            ZFG1$ = ZFG1Def$ : _
  2128.            ZFG2$ = ZFG2Def$ : _
  2129.            ZFG3$ = ZFG3Def$ : _
  2130.            ZFG4$ = ZFG4Def$
  2131.       END SUB
  2132. 59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts'
  2133. ' $PAGE
  2134. '
  2135. '  NAME    --  ColorPrompt
  2136. '
  2137. '  INPUTS  --  PARAMETER                   MEANING
  2138. '              Strng$              String to colorize
  2139. '              ZHiLiteOff          Whether highlighting is off
  2140. '              ZEmphasizeOn$       String to use for emphasis
  2141. '              ZEmphasizeOff$      String to use after emphasis
  2142. '
  2143. '  OUTPUTS --  Strng$              Colorized string
  2144. '
  2145. '  PURPOSE -- colorizes a string based on sysop settings
  2146. '             and the string.
  2147. '                        [...] is the default - put in emphasis
  2148. '                        <...> options to type - put in ZFG4$
  2149. '                        and first two preceeding words use ZFG1$ and ZFG2$
  2150. '                        options identified on right by ) and on
  2151. '                        left by space or comma - put in ZFG4$
  2152. '
  2153.       SUB ColorPrompt (Strng$) STATIC
  2154.       IF ZHiLiteOff THEN _
  2155.          EXIT SUB
  2156.       AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0)
  2157.       WasX = INSTR(Strng$,"<")
  2158.       IF WasX > 0 THEN _
  2159.          GOTO 59943
  2160.       WasX = INSTR(Strng$,"[")   ' highlight default
  2161.       IF WasX > 0 THEN _
  2162.          WasY = INSTR(WasX,Strng$,"]") : _
  2163.          IF WasY > 0 THEN _
  2164.             CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$)
  2165.       IF AlreadyColorized THEN _
  2166.          EXIT SUB
  2167.       WasX = INSTR(Strng$,"<")
  2168.       IF WasX < 1 THEN _
  2169.          GOTO 59945
  2170. 59943 WasY = INSTR(WasX,Strng$,">")
  2171.       IF WasY < 1 THEN _
  2172.          GOTO 59945
  2173.       CALL Bracket (Strng$,WasX,WasY,ZFG4$,ZEmphasizeOff$)
  2174.       WasY = INSTR(Strng$," ")
  2175.       IF WasY > 1 AND WasY < WasX THEN _
  2176.          Strng$ = ZFG1$ + Strng$ : _
  2177.          WasZ = INSTR(WasY+1,Strng$," ") : _
  2178.          IF WasZ > 1 AND WasZ < WasX+LEN(ZFG1$) THEN _
  2179.             Strng$ = LEFT$(Strng$,WasZ) + ZFG2Def$ + MID$(Strng$,WasZ+1)
  2180.       EXIT SUB
  2181. 59945 WasX = 1
  2182.       DidInsert = ZFalse
  2183.       WasL = LEN(ZFG4$)
  2184. 59950 WasY = INSTR (WasX,Strng$,")")  ' x: where command begins, y: terminating pos
  2185.       WasZ = INSTR (WasX,Strng$,",")
  2186.       IF WasY = 0 OR (WasZ > 0 AND WasZ < WasY) THEN _
  2187.          WasY = WasZ
  2188.       WasK = LEN(Strng$)
  2189.       IF WasX > WasK THEN _
  2190.          EXIT SUB
  2191.       IF WasY < 1 THEN _
  2192.          IF NOT DidInsert THEN _
  2193.             EXIT SUB _
  2194.          ELSE WasY = WasK+1
  2195.       WasZ = WasY - 1
  2196.       WHILE WasZ > 0    ' got terminating pos: find beginning
  2197.          IF INSTR(ZOptionEnd$,MID$(Strng$,WasZ,1)) > 0 THEN _
  2198.             WasX = WasZ + 1 : _
  2199.             WasZ = 0
  2200.          WasZ = WasZ - 1
  2201.       WEND
  2202.       IF WasY-WasX < 3 THEN _     ' exclude commands too long
  2203.          CmndString$ = MID$(Strng$,WasX,WasY-WasX) : _
  2204.          WasX$ = CmndString$ : _
  2205.          CALL AllCaps (CmndString$) : _
  2206.          IF WasX$ = CmndString$ THEN _  ' exclude lower case
  2207.             DidInsert = ZTrue : _
  2208.             CALL Bracket (Strng$,WasX,WasY-1,ZFG4$,ZEmphasizeOff$) : _  ' colorize
  2209.             WasY = WasY + WasL
  2210.       WasX = WasY + 1
  2211.       GOTO 59950
  2212.       END SUB
  2213. 59960 ' $SUBTITLE: 'Bracket - Inserts strings around a string'
  2214. ' $PAGE
  2215. '
  2216. '  NAME    --  Bracket
  2217. '
  2218. '  INPUTS  --  PARAMETER                   MEANING
  2219. '              Strng$              Insert in this string
  2220. '              B4Here              Insert 1st before this pos
  2221. '              AfterHere           Insert 2nd after this pos
  2222. '              B4String$           String to insert before
  2223. '              AfterString$        String to insert after
  2224. '
  2225. '  OUTPUTS --  Strng$
  2226. '
  2227. '  PURPOSE -- Primarily for colorization
  2228. '
  2229.       SUB Bracket (Strng$,B4Here,AfterHere,B4String$,AfterString$) STATIC
  2230.       Strng$ = LEFT$(Strng$,B4Here-1) + _
  2231.                B4String$ + _
  2232.                MID$(Strng$,B4Here,AfterHere-B4Here+1) + _
  2233.                AfterString$ + _
  2234.                RIGHT$(Strng$,LEN(Strng$) - AfterHere)
  2235.       END SUB
  2236. 59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text'
  2237. ' $PAGE
  2238. '
  2239. '  NAME    --  UserColor
  2240. '
  2241. '  INPUTS  --  PARAMETER                   MEANING
  2242. '              ZEmphasizeOff$            Normal text color
  2243. '
  2244. '  OUTPUTS --  ZEmphasizeOff$            New text color
  2245. '              ZBoldText$                Whether bold (0 not, 1 bold)
  2246. '              ZUserTextColor            ANSI Color selected
  2247. '
  2248. '  PURPOSE --  Lets caller select desired color and whether bold.
  2249. '
  2250.       SUB UserColor STATIC
  2251.       IF ZHiLiteOff THEN _
  2252.          EXIT SUB
  2253. 59970 CALL QuickTPut (ZEmphasizeOff$,0)
  2254.       ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$
  2255.       GOSUB 59973
  2256.       IF ZWasQ = 0 THEN _
  2257.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  2258.              ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
  2259.          EXIT SUB
  2260.       CALL AllCaps (ZUserIn$)
  2261.       WasX = INSTR("RGYBPCW",ZUserIn$)
  2262.       IF WasX = 0 THEN _
  2263.          GOTO 59970
  2264.       ZUserTextColor = 30 + WasX
  2265.       ZOutTxt$ = "Make text BOLD (Y,[N])"
  2266.       GOSUB 59973
  2267.       ZBoldText$ = CHR$(48 - ZYes)
  2268.       ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  2269.       GOTO 59970
  2270. 59973 ZSubParm = 1
  2271.       ZTurboKey = -ZTurboKeyUser
  2272.       CALL TGet
  2273.       IF ZSubParm = -1 THEN _
  2274.          EXIT SUB
  2275.       RETURN
  2276.       END SUB
  2277. 59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference'
  2278. ' $PAGE
  2279. '
  2280. '  NAME    --  SetGraphic
  2281. '
  2282. '  INPUTS  --  PARAMETER                   MEANING
  2283. '              GraphicsNumber        0=None, 1=Ascii, 2=color
  2284. '
  2285. '  OUTPUTS --  ZWasGR                Shared var - set to
  2286. '                                    graphics.number
  2287. '              GraphicsLetter$       What add to file name to
  2288. '                                see if got graphics file ver
  2289. '
  2290. '  PURPOSE --  Sets file graphics preference
  2291. '
  2292.       SUB SetGraphic (GraphicsNumber,GraphicsLetter$) STATIC
  2293.       ZWasGR = GraphicsNumber
  2294.       IF ZWasGR = 2 THEN _
  2295.          ZDR1$ = ZFG1Def$ : _
  2296.          ZDR2$ = ZFG2Def$ : _
  2297.          ZDR3$ = ZFG3Def$ : _
  2298.          ZDR4$ = ZFG4Def$ _
  2299.       ELSE ZDR1$ = "" : _
  2300.            ZDR2$ = "" : _
  2301.            ZDR3$ = "" : _
  2302.            ZDR4$ = ""
  2303.       GraphicsLetter$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0))
  2304.       END SUB
  2305. 60000 ' $SUBTITLE: 'EofComm - Determines whether input in comm port buffer'
  2306. ' $PAGE
  2307. '
  2308. '  NAME    --  EofComm
  2309. '
  2310. '  INPUTS  --  PARAMETER                   MEANING
  2311. '               ZFossil              Whether fossil driver used
  2312. '               ZComPort            Comm port # in use
  2313. '
  2314. '  OUTPUTS --  NoChars           -1 (True) if no chars in buffer.
  2315. '                                   Anything else means has char.
  2316. '
  2317. '  PURPOSE -- Query comm port to see if input waiting
  2318. '
  2319.       SUB EofComm (NoChars) STATIC
  2320.       IF ZFossil THEN _
  2321.          CALL FosReadAhead(ZComPort,NoChars) _
  2322.       ELSE NoChars = EOF(3)
  2323.       END SUB
  2324. 60100 ' $SUBTITLE: 'GlobalSrchRepl - Global search and replace'
  2325. ' $PAGE
  2326. '
  2327. '  NAME    --  GlobalSrchRepl
  2328. '
  2329. '  INPUTS  --  PARAMETER                   MEANING
  2330. '              Strng$              String to edit
  2331. '              LookFor$           String to look for
  2332. '              ReplaceBy$         String to replace by
  2333. '
  2334. '  OUTPUTS --  Strng$              Edited string
  2335. '
  2336. '  PURPOSE --  Replaces every occurence of LookFor$ that
  2337. '                         is in Strng$ by ReplaceBy$
  2338. '
  2339.       SUB GlobalSrchRepl (Strng$,LookFor$,ReplaceBy$,OverStrike) STATIC
  2340.       IF LookFor$ = "" THEN _
  2341.          EXIT SUB
  2342.       WasX = 1
  2343.       WasL = LEN(ReplaceBy$)
  2344.       ZMsgPtr = LEN(LookFor$)
  2345. 60102 WasY = INSTR(WasX,Strng$,LookFor$)
  2346.       IF WasY < 1 THEN _
  2347.          EXIT SUB
  2348.       IF OverStrike THEN _
  2349.          MID$(Strng$,WasY) = ReplaceBy$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2350.       ELSE Strng$ = LEFT$(Strng$,WasY-1) + _
  2351.                     ReplaceBy$ + _
  2352.                     RIGHT$(Strng$,LEN(Strng$)-WasY+1-ZMsgPtr)
  2353.       WasX = WasY + WasL
  2354.       IF WasX > LEN(Strng$) THEN _
  2355.          EXIT SUB
  2356.       GOTO 60102
  2357.       END SUB
  2358. 60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace'
  2359. ' $PAGE
  2360. '
  2361. '  NAME    --  MetaGSR
  2362. '
  2363. '  INPUTS  --  PARAMETER               MEANING
  2364. '              Strng$              String to edit
  2365. '
  2366. '  OUTPUTS --  Strng$              Edited string
  2367. '
  2368. '  PURPOSE --  Global search and replace for meta variables
  2369. '
  2370.       SUB MetaGSR (Strng$,OverStrike) STATIC
  2371.       WasY = 1
  2372. 60131 IF WasY > LEN(Strng$) THEN _
  2373.          EXIT SUB
  2374.       WasX = INSTR(WasY,Strng$,"[")
  2375.       IF WasX = 0 THEN _
  2376.          EXIT SUB
  2377.       WasY = INSTR(WasX,Strng$,"]")
  2378.       IF WasY = 0 THEN _
  2379.          EXIT SUB
  2380.       ZMsgPtr = WasY-WasX+1
  2381.       Temp = WasY-WasX-1
  2382.       CALL CheckInt(MID$(Strng$,WasX+1,Temp))
  2383.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR (ZTestedIntValue > ZMaxWorkVar) THEN _
  2384.          GOTO 60135
  2385.       IF ((ZTestedIntValue < 10) AND (Temp = 1)) OR ((ZTestedIntValue > 9) AND (Temp = 2)) THEN _
  2386.          GOTO 60132
  2387.       WasY = WasX + 1
  2388.       GOTO 60131
  2389. 60132 WorkHold$ = ZGSRAra$(ZTestedIntValue)
  2390.       IF WasY = LEN(Strng$) THEN _
  2391.          GOTO 60151
  2392.       IF MID$(Strng$,WasY+1,1) <> "(" THEN _
  2393.          GOTO 60151
  2394.       WasI = INSTR(WasY+1,Strng$,")")
  2395.       IF WasI = 0 THEN _
  2396.          GOTO 60151
  2397.       WasJ = INSTR(WasY+1,Strng$,":")
  2398.       IF WasJ > WasI THEN _
  2399.          GOTO 60151
  2400.       CALL CheckInt (MID$(Strng$,WasY+2))
  2401.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  2402.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2403.             GOTO 60151
  2404.       WasY = WasI
  2405.       ZMsgPtr = WasI-WasX+1
  2406.       StartSub = ZTestedIntValue
  2407.       CALL CheckInt (MID$(Strng$,WasJ+1))
  2408.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR _
  2409.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2410.             GOTO 60151
  2411.       LenSub = ZTestedIntValue
  2412.       WorkHold$ = MID$(WorkHold$,StartSub,LenSub)
  2413.       GOTO 60151
  2414. 60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1)
  2415.       WasI = INSTR("      BAUD  PORT  PORT# PARITYPROTO NODE  FILE  ",MetaVal$)
  2416.       IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _
  2417.          WasY = WasX + 1 : _
  2418.          GOTO 60131
  2419.       WasJ = (WasI-1)\6 + 1
  2420.       WasK = (WasI+4)\6 + 1
  2421.       IF WasK > WasJ THEN _
  2422.          EXIT SUB
  2423.       ON WasJ GOTO 60155, _
  2424.                 60137, _
  2425.                 60139, _
  2426.                 60141, _
  2427.                 60143, _
  2428.                 60145, _
  2429.                 60147, _
  2430.                 60149, _
  2431.                 60151
  2432. 60137 WorkHold$ = ZTalkToModemAt$
  2433.       GOTO 60151
  2434. 60139 WorkHold$ = ZComPort$
  2435.       GOTO 60151
  2436. 60141 WorkHold$ = MID$(ZComPort$,4)
  2437.       GOTO 60151
  2438. 60143 WorkHold$ = MID$(ZBaudParity$,INSTR(ZBaudParity$,",")+1,1)
  2439.       GOTO 60151
  2440. 60145 WorkHold$ = ZWasFT$
  2441.       GOTO 60151
  2442. 60147 WorkHold$ = ZNodeID$
  2443.       GOTO 60151
  2444. 60149 IF ZBatchTransfer THEN _
  2445.          WorkHold$ = "@" + ZNodeWorkFile$ _
  2446.       ELSE WorkHold$ = ZFileName$
  2447.       GOTO 60151
  2448. 60151 WasL = LEN(WorkHold$)
  2449.       IF OverStrike THEN _
  2450.          MID$(Strng$,WasX) = WorkHold$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2451.       ELSE Strng$ = LEFT$(Strng$,WasX-1) + WorkHold$ + RIGHT$(Strng$,LEN(Strng$)-WasY)
  2452.       WasY = 1 ' WasY = WasX + WasL
  2453.       GOTO 60131
  2454. 60155 WasY = WasY + 1
  2455.       GOTO 60131
  2456.       END SUB
  2457. 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
  2458. ' $PAGE
  2459. '
  2460. '  NAME    --  TimeLock  (written by Doug Azzarito)
  2461. '
  2462. '  INPUTS  --  PARAMETER                   MEANING
  2463. '              ZTimeLockSet               SECONDS/SESSION TO LOCK
  2464. '
  2465. '  OUTPUTS --  ZSubParm     -1 if feature is LOCKED
  2466. '
  2467. '  PURPOSE -- Check elapsed time for lock duration
  2468. '
  2469.       SUB TimeLock STATIC
  2470.       CALL TimeRemain(MinsRemaining)
  2471.       IF ZSecsUsedSession! >= ZTimeLockSet THEN _
  2472.          ZOK = ZTrue : _
  2473.          EXIT SUB
  2474.       ZOutTxt$ = ZFirstName$
  2475.       CALL NameCaps(ZOutTxt$)
  2476.       CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _
  2477.                    STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _' DA11102
  2478.                    " more minutes" + _
  2479.                    STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds")
  2480.       CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
  2481.       ZOK = ZFalse
  2482.       ZLastIndex = 0                                                 ' KG061501
  2483.       END SUB
  2484. 60200 ' $SUBTITLE: 'MarkTime - Give feedback for lengthy processes'
  2485. ' $PAGE
  2486. '
  2487. '  NAME    --  MarkTime
  2488. '
  2489. '  INPUTS  --  PARAMETER                   MEANING
  2490. '              DotNumber          How many dots printed
  2491. '
  2492. '  OUTPUTS --  DotNumber
  2493. '
  2494. '  PURPOSE --  Marks time by putting colorized dots out
  2495. '              to 4, then erasing
  2496. '
  2497.       SUB MarkTime (DotNumber) STATIC
  2498.       TimeNow! = TIMER
  2499.       IF TimeNow! - PrevTI! < 1.0 THEN _
  2500.          EXIT SUB
  2501.       PrevTI! = TimeNow!
  2502.       IF RemoveDot AND DotNumber > 0 THEN _
  2503.          CALL QuickTPut (ZBackSpace$,0) : _
  2504.          DotNumber = DotNumber - 1 : _
  2505.          EXIT SUB
  2506.       DotNumber = DotNumber + 1
  2507.       ON DotNumber GOTO 60201,60202,60203,60204
  2508. 60201 WasX$ = ZFG1$
  2509.       RemoveDot = ZFalse
  2510.       GOTO 60205
  2511. 60202 WasX$ = ZFG2$
  2512.       GOTO 60205
  2513. 60203 WasX$ = ZFG3$
  2514.       GOTO 60205
  2515. 60204 WasX$ = ZFG4$
  2516.       RemoveDot = ZTrue
  2517. 60205 CALL QuickTPut (WasX$ + "." + ZEmphasizeOff$,0)
  2518.       END SUB
  2519. 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
  2520. ' $PAGE
  2521. '
  2522. '  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
  2523. '                        'and RoseMarie Siddiqui
  2524. '
  2525. '  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
  2526. '                                       notification and how
  2527. '
  2528. '  OUTPUTS -- NONE
  2529. '
  2530. '  PURPOSE -- Search ZAutoPageDef$ for match on whether
  2531. '             on name, security level, whether new user.
  2532. '             Also controls whether caller notified and
  2533. '             number of times sysop has bell rung.
  2534. '             And what tune to play (if any).
  2535. '
  2536.       SUB AutoPage STATIC
  2537.       CALL FindIt (ZAutoPageDef$)
  2538.       IF NOT ZOK THEN _
  2539.          EXIT SUB
  2540.       ZErrCode = 0
  2541.       ZOK = ZFalse
  2542.       WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
  2543.          CALL ReadParms (ZWorkAra$(),4,1)
  2544.          IF ZErrCode = 0 THEN _
  2545.             ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
  2546.             IF NOT ZOK THEN _
  2547.                IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
  2548.                   ZOK = ZTrue _
  2549.                ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
  2550.                        ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
  2551.                        IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
  2552.                           IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
  2553.                              ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
  2554.                                 ZOK = ZTrue
  2555.       WEND
  2556.       CLOSE 2
  2557.       IF ZErrCode > 0 OR NOT ZOK THEN _
  2558.          ZErrCode = 0 : _
  2559.          EXIT SUB
  2560.       ZPageStatus$ = "AP!"                                           ' DA080902
  2561.       IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
  2562.          ZOutTxt$ = "Telling sysop you're on..." : _
  2563.          CALL RingCaller
  2564.       ZWasB = (ZWorkAra$(4) = "")
  2565.       ZWorkAra$(5) = ""
  2566.      TempSnoop = ZSnoop                                              ' DA101801
  2567.      ZSnoop = ZTrue                                                  ' DA101801
  2568.      CALL Line25                                                     ' DA102401
  2569.       FOR WasI = 1 TO VAL(ZWorkAra$(3))
  2570.          IF ZWasB THEN _
  2571.             CALL LPrnt (ZBellRinger$,0) : _
  2572.          ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
  2573.       NEXT
  2574.       IF NOT ZWasB THEN _
  2575.          CALL RBBSPlay (ZWorkAra$(5))
  2576.       ZSnoop = TempSnoop                                             ' DA101801
  2577.       END SUB
  2578. 62520 ' $SUBTITLE: 'PutMsgAttr - subroutine to save msg. attributes'
  2579. ' $PAGE
  2580. '
  2581. '  NAME    --  PutMsgAttr
  2582. '
  2583. '  INPUTS  --  PARAMETER                   MEANING
  2584. '              ZWasQ
  2585. '              ZUserIn$
  2586. '              ZLinesInMsg
  2587. '              ZWasS
  2588. '              ZNonStop
  2589. '              ZMsgDimIndex
  2590. '
  2591. '  OUTPUTS --  ZWasSQ
  2592. '              ZWasLG$(10)
  2593. '              ZLinesInMsgSave
  2594. '              ZWasSL
  2595. '              ZNonStopSave
  2596. '              ZMsgDimIndexSave
  2597. '
  2598. '  PURPOSE --  WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES
  2599. '              THE ATTRIBUTES OF THE ORGINAL MESSAGE
  2600. '
  2601.       SUB PutMsgAttr STATIC
  2602.       ZWasSQ = ZWasQ
  2603.       ZWasLG$(10) = ZUserIn$
  2604.       ZLinesInMsgSave = ZLinesInMsg
  2605.       ZWasSL = ZWasS
  2606.       ZNonStopSave = ZNonStop
  2607.       ZMsgDimIndexSave = ZMsgDimIndex
  2608.       END SUB
  2609. 62530 ' $SUBTITLE: 'GetMsgAttr - subroutine to get msg. attributes'
  2610. ' $PAGE
  2611. '
  2612. '  NAME    --  GetMsgAttr
  2613. '
  2614. '  INPUTS  --  PARAMETER                   MEANING
  2615. '              ZWasSQ
  2616. '              ZWasLG$(10)
  2617. '              ZLinesInMsgSave
  2618. '              ZWasSL
  2619. '              ZNonStopSave
  2620. '              ZMsgDimIndexSave
  2621. '
  2622. '  OUTPUTS --  ZWasQ
  2623. '              ZUserIn$
  2624. '              LINES.IN.MESSAGESAVE
  2625. '              ZWasS
  2626. '              ZNonStop
  2627. '              ZMsgDimIndex
  2628. '              ZKillMessage
  2629. '
  2630. '  PURPOSE --  After replying to a message this routine restores
  2631. '              the attributes of the orginal message
  2632. '
  2633.       SUB GetMsgAttr STATIC
  2634.       ZWasQ = ZWasSQ
  2635.       ZUserIn$ = ZWasLG$(10)
  2636.       ZLinesInMsg = ZLinesInMsgSave
  2637.       ZWasS = ZWasSL
  2638.       ZNonStop = ZNonStopSave
  2639.       ZMsgDimIndex = ZMsgDimIndexSave
  2640.       ZKillMessage = ZFalse
  2641.       END SUB
  2642. 62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
  2643. ' $PAGE
  2644. '
  2645. '  NAME    --  RptTime
  2646. '
  2647. '  INPUTS  --  PARAMETER                   MEANING
  2648. '
  2649. '  OUTPUTS --
  2650. '
  2651. '  PURPOSE --  Tells user time used on system
  2652. '
  2653.       SUB RptTime STATIC
  2654.       CALL SkipLine (1)
  2655.       CALL GetTime
  2656.       CALL AMorPM
  2657.       Mins = (ZSessionHour * 60) + ZSessionMin
  2658.       CALL Carrier
  2659.       IF ZSubParm = -1 THEN _
  2660.          EXIT SUB
  2661.       CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$)
  2662.       CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _
  2663.                         STR$(ZSessionSec) + " secs")
  2664.       CALL Talk (7,ZOutTxt$)
  2665.       END SUB
  2666. 62600 ' $SUBTITLE: 'Protocol - Determine protocols available'
  2667. ' $PAGE
  2668. '
  2669. '  NAME    -- Protocol
  2670. '
  2671. '  INPUTS  --     PARAMETER                    MEANING
  2672. '                 ZProtoDef$                File of installed protocols
  2673. '
  2674. '  OUTPUTS -- ZTransferOption$         Prompt for protocol choice
  2675. '             ZDefaultXfer$            Letters of protocols
  2676. '             ZInternalEquiv$          Internal protocol to use
  2677. '
  2678. '  PURPOSE -- TO determine what protocols are available to user
  2679. '
  2680.       SUB Protocol STATIC
  2681.       CALL FindIt (ZProtoDef$)
  2682.       IF NOT ZOK THEN _
  2683.          ZTransferOption$ = "A)scii,X)modem,C)rcXmodem,Y)modem" : _
  2684.          ZInternalEquiv$ = "AXCY" : _
  2685.          ZDefaultXfer$ = "AXCY" : _
  2686.          GOTO 62604
  2687.       ZDefaultXfer$ = ""
  2688.       ZInternalEquiv$ = ""
  2689.       ZTransferOption$ = ""
  2690.       WasL = 0
  2691. 62602 IF EOF(2) THEN _
  2692.          GOTO 62604
  2693.       CALL ReadParms (ZWorkAra$(),13,1)
  2694.       IF ZErrCode > 0 THEN _
  2695.          EXIT SUB
  2696.       ZDefaultXfer$ = ZDefaultXfer$ + " "
  2697.       ZInternalEquiv$ = ZInternalEquiv$ + " "
  2698.       IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  2699.          GOTO 62602
  2700.       IF LEFT$(ZWorkAra$(5),1) = "R" THEN _
  2701.          IF NOT ZReliableMode THEN _
  2702.             GOTO 62602
  2703.       IF LEFT$(ZWorkAra$(3),1) = "I" THEN _
  2704.          GOTO 62603
  2705.       WasX = INSTR(ZWorkAra$(12)+" "," ")
  2706.       WasX$ = LEFT$(ZWorkAra$(12),WasX-1)
  2707.       CALL FindFile (WasX$,Found)
  2708.       IF Found THEN _
  2709.          WasX = INSTR(ZWorkAra$(13)+" "," ") : _
  2710.          WasX$ = LEFT$(ZWorkAra$(13),WasX-1) : _
  2711.          CALL FindFile (WasX$,Found)
  2712.       IF NOT Found THEN _
  2713.          GOTO 62602
  2714. 62603 MID$(ZDefaultXfer$,LEN(ZDefaultXfer$),1) = LEFT$(ZWorkAra$(1),1)
  2715.       CALL FindLast (ZWorkAra$(1),ZCrLf$,WasX,WasI)
  2716.       IF WasX > 0 AND WasX >= LEN(ZWorkAra$(1)) - 2 THEN _
  2717.          ZWorkAra$(1) = LEFT$(ZWorkAra$(1),WasX-1)
  2718.       IF (WasL + LEN(ZWorkAra$(1)) < 62) AND WasX = 0 THEN _
  2719.          ZTransferOption$ = ZTransferOption$ + "," + ZWorkAra$(1) : _
  2720.          WasL = WasL + LEN(ZWorkAra$(1)) + 1 _
  2721.       ELSE WasL = LEN(ZWorkAra$(1)) : _
  2722.            ZTransferOption$ = ZTransferOption$ + _
  2723.                               ZCrLf$ + _
  2724.                               ZWorkAra$(1)
  2725.       IF LEFT$(ZWorkAra$(3),1) = "I" AND RIGHT$(ZWorkAra$(3),1) <> "I" THEN _
  2726.          MID$(ZInternalEquiv$,LEN(ZInternalEquiv$),1) = RIGHT$(ZWorkAra$(3),1)
  2727.       GOTO 62602
  2728. 62604 IF INSTR(ZInternalEquiv$,"N") > 0 THEN _
  2729.          GOTO 62605
  2730.       IF WasX = 0 THEN _
  2731.          ZTransferOption$ = ZTransferOption$ + ",N)one" _
  2732.       ELSE ZTransferOption$ = ZTransferOption$ + ZCrLf$ + "N)one"
  2733.       ZDefaultXfer$ = ZDefaultXfer$ + "N"
  2734.       ZInternalEquiv$ = ZInternalEquiv$ + "N"
  2735. 62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
  2736.          ZTransferOption$ = MID$(ZTransferOption$,2)
  2737.       IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
  2738.          CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+" unavailable.  Default reset to None") : _
  2739.          ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
  2740.       END SUB
  2741. 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
  2742. ' $PAGE
  2743. '
  2744. '  NAME    -- Transfer
  2745. '
  2746. '  INPUTS  --     PARAMETER                    MEANING
  2747. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2748. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2749. '              ZFileName$                NAME OF FILE FOR Transfer
  2750. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2751. '                                        TO BE USED BY KERMIT (COM1
  2752. '                                        OR COM2)
  2753. '              ZBPS                      = -1 FOR   300 BAUD
  2754. '                                        = -2 FOR   450 BAUD
  2755. '                                        = -3 FOR  1200 BAUD
  2756. '                                        = -4 FOR  2400 BAUD
  2757. '                                        = -5 FOR  4800 BAUD
  2758. '                                        = -6 FOR  9600 BAUD
  2759. '                                        = -7 FOR 19200 BAUD
  2760. '
  2761. '  OUTPUTS  -- NONE
  2762. '
  2763. '  PURPOSE -- To transfer files using external protocols
  2764. '
  2765.       SUB Transfer STATIC
  2766.       IF ZPrivateDoor THEN _
  2767.          CALL PrivDoorRtn : _
  2768.          EXIT SUB
  2769.       IF ZTransferFunction = 1 THEN _
  2770.          ZUserIn$ = ZDownTemplate$ : _
  2771.          ZWasZ$ = "send " _
  2772.       ELSE IF ZTransferFunction = 2 THEN _
  2773.               ZUserIn$ = ZUpTemplate$ : _
  2774.               ZWasZ$ = "receive "
  2775.       CALL MetaGSR (ZUserIn$,ZFalse)
  2776.       CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
  2777.       CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0)
  2778.       IF ZBatchTransfer THEN _
  2779.          CALL QuickTPut1 ("(BATCH)") : _
  2780.          CALL OpenWork (2,ZNodeWorkFile$) : _
  2781.          WHILE NOT EOF(2) : _
  2782.            CALL ReadAny : _
  2783.            CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
  2784.            CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
  2785.          WEND _
  2786.       ELSE CALL QuickTPut1 (ZFileNameHold$)
  2787.       IF ZAutoLogoffReq THEN _
  2788.          CALL QuickTPut1 ("Automatic logoff, if download OK")        ' KG071902
  2789.       CALL PrivDoorRtn
  2790.       END SUB
  2791. 62624 ' $SUBTITLE: 'PrivDoorRtn - subroutine to exit as a private door.'
  2792. ' $PAGE
  2793. '
  2794. '  NAME    -- PrivDoorRtn
  2795. '
  2796. '  INPUTS  --     PARAMETER                    MEANING
  2797. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2798. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2799. '                                        = 3 USER REGISTRATION PGM
  2800. '              ZUserIn$                      NAME OF FILE TO EXIT TO
  2801. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2802. '                                        TO BE USED BY KERMIT (COM1
  2803. '                                        OR COM2)
  2804. '              ZBPS                      = -1 FOR   300 BAUD
  2805. '                                        = -2 FOR   450 BAUD
  2806. '                                        = -3 FOR  1200 BAUD
  2807. '                                        = -4 FOR  2400 BAUD
  2808. '                                        = -5 FOR  4800 BAUD
  2809. '                                        = -6 FOR  9600 BAUD
  2810. '                                        = -7 FOR 19200 BAUD
  2811. '
  2812. '  OUTPUTS -- NONE
  2813. '
  2814. '  PURPOSE -- To transfer control to another program
  2815. '
  2816.       SUB PrivDoorRtn STATIC
  2817.       IF ZPrivateDoor THEN _
  2818.          GOTO 62630
  2819.       IF ZFakeXRpt THEN _
  2820.          CALL FakeXRpt (ZWasFT$)
  2821.       IF ZAdvanceProtoWrite THEN _
  2822.          CALL OpenOutW ("XFER-"+ZNodeID$+".DEF") : _
  2823.          IF ZErrCode < 1 THEN _
  2824.             CALL PrintWorkA (ZFileName$+",,"+ZWasFT$) : _
  2825.             CLOSE 2
  2826.       IF ZProtoMethod$ = "S" THEN _
  2827.          GOTO 62629
  2828. 62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
  2829.       IF WasX$ = "" THEN _
  2830.          EXIT SUB
  2831.       CALL FindIt (WasX$)
  2832.       IF NOT ZOK THEN _
  2833.          ZOutTxt$ = "Missing door program" : _
  2834.          CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
  2835.          ZSnoop = ZTrue : _
  2836.          CALL LPrnt (ZOutTxt$,1) : _
  2837.          EXIT SUB
  2838.       ZOutTxt$(1) = "CLS"
  2839.       GOSUB 62633
  2840.       ZOutTxt$(2) = "ECHO" + ZOutTxt$
  2841.       ZOutTxt$(3) = ZDiskForDos$ + _
  2842.               "COMMAND /C " + _
  2843.               ZUserIn$
  2844.       ZOutTxt$(4) = ZRBBSBat$
  2845.       ZPrivateDoor = ZTrue
  2846.       CALL QuickTPut1 ("Exiting to External Pgm for Transfer")
  2847.       LOCATE 25,1
  2848.       CALL LPrnt(ZLineFeed$,0)
  2849.       CALL RBBSExit (ZOutTxt$(),4)
  2850. 62629 GOSUB 62633
  2851.       CLS
  2852.       CALL LPrnt (ZOutTxt$,1)
  2853.       CALL ShellExit (ZUserIn$)
  2854. 62630 IF ZPrivateDoor THEN _
  2855.          CALL RestoreCom : _
  2856.          CALL DelayTime (7 + ZBPS) : _
  2857.          CALL SetBaud : _
  2858.          CALL QuickTPut1 ("Reloading RBBS-PC.  Please be patient.")
  2859. 62631 CALL SkipLine (2)
  2860.       LOCATE 24,1
  2861. 62632 EXIT SUB
  2862. 62633 ZOutTxt$ = STR$(ZUserSecLevel) + _
  2863.                  " " + _
  2864.                  ZActiveUserName$ + _
  2865.                  " " + _
  2866.                  ZWasCI$
  2867.       RETURN
  2868.       END SUB
  2869. 62650 ' $SUBTITLE: 'FakeXRpt - subroutine to create fake xfer report'
  2870. ' $PAGE
  2871. '
  2872. '  NAME    --  FakeXRpt
  2873. '
  2874. '  INPUTS  --  PARAMETER                   MEANING
  2875. '              ZFileNameHold$      FILE TO BE TRANSFERRED
  2876. '              ProtoUsed$          Protocol USED
  2877. '
  2878. '  OUTPUTS --  WRITES OUT Transfer FILE REPORT
  2879. '
  2880. '  PURPOSE --  External protocol drivers that do not write
  2881. '              out a standard transfer report must have one
  2882. '              provided in order for "dooring" to external
  2883. '              protocols to work properly, since this file
  2884. '              is read upon returning from an external protocol.
  2885. '
  2886.       SUB FakeXRpt (ProtoUsed$) STATIC
  2887.       CLOSE 2
  2888.       OPEN "O",2,"XFER-" + _
  2889.                  ZNodeFileID$ + _
  2890.                  ".DEF"
  2891.       PRINT #2,ZFileName$
  2892.       PRINT #2,
  2893.       PRINT #2,ProtoUsed$
  2894.       PRINT #2,"S"
  2895.       CLOSE 2
  2896.       END SUB
  2897. 62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change'
  2898. ' $PAGE
  2899. '
  2900. '  NAME    --  SetExpert
  2901. '
  2902. '  INPUTS  --  PARAMETER                   MEANING
  2903. '              ZExpertUser          WHETHER IS AN EXPERT
  2904. '
  2905. '  OUTPUTS --  ZMorePrompt$         Pause prompt
  2906. '              ZPressEnter$         Prompt to press enter
  2907. '
  2908. '  PURPOSE --  Make more helpful prompt for novices and shorter
  2909. '              one for experts
  2910. '
  2911.       SUB SetExpert STATIC
  2912.       IF ZExpertUser THEN _
  2913.          ZMorePrompt$ = "More <[Y],N,C,A" : _
  2914.          ZPressEnter$ = ZPressEnterExpert$ : _
  2915.          EXIT SUB
  2916.       ZMorePrompt$ = "More [Y]es,N)o,C)ont,A)bort"
  2917.       ZPressEnter$ = ZPressEnterNovice$
  2918.       END SUB
  2919. 62668 ' $SUBTITLE: 'NewPassword - subroutine to get new password'
  2920. ' $PAGE
  2921. '
  2922. '  NAME    --  NewPassword
  2923. '
  2924. '  INPUTS  --  PARAMETER                   MEANING
  2925. '              Prompt$               Prompt to display
  2926. '              DisallowSpaces        Whether answer can have all spaces
  2927. '
  2928. '  OUTPUTS --  ZWasZ$                   Password
  2929. '
  2930. '  PURPOSE --  To get a new password.
  2931. '
  2932.       SUB NewPassword (Prompt$,DisallowSpaces) STATIC
  2933. 62670 ZOutTxt$ = Prompt$
  2934.       ZHidden = ZTrue
  2935.       CALL PopCmdStack
  2936.       ZHidden = ZFalse
  2937.       IF ZSubParm < 0 OR ZWasQ = 0 THEN _
  2938.          EXIT SUB
  2939.       IF LEN(ZUserIn$) > 15 THEN _
  2940.          CALL QuickTPut1 ("15 chars max") : _
  2941.          GOTO 62670
  2942.       IF INSTR(ZUserIn$,";") > 0 THEN _
  2943.          CALL QuickTPut1 ("Cannot use ';'") : _
  2944.          GOTO 62670
  2945.       IF DisallowSpaces THEN _
  2946.          IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
  2947.             CALL QuickTPut1 ("Not all blanks") : _
  2948.             GOTO 62670
  2949.       CALL AllCaps (ZUserIn$)
  2950.       ZWasZ$ = ZUserIn$
  2951.       END SUB
  2952. 63000 ' $SUBTITLE: 'TimedOut - exits based on time of day'
  2953. ' $PAGE
  2954. '
  2955. '  NAME    --  TimedOut
  2956. '
  2957. '  INPUTS  --  PARAMETER                   MEANING
  2958. '              ZRCTTYBat$
  2959. '              ZNodeRecIndex
  2960. '              ZMsgRec$
  2961. '              ZModemInitBaud$
  2962. '              ZModemGoOffHookCmnd$
  2963. '
  2964. '  OUTPUTS --  NONE
  2965. '
  2966. '  PURPOSE --  When RBBS-PC is to exit to DOS at a specific time of
  2967. '              day, this routine writes out to the file specified
  2968. '              in "RCTTY.BAT" the one-line entry:
  2969. '                          RBBSxTM.BAT
  2970. '               WHERE "x" is the node id.
  2971. '
  2972.       SUB TimedOut STATIC
  2973.       FIELD #1,128 AS ZMsgRec$
  2974.       ZSubParm = 3
  2975.       CALL FileLock
  2976.       GET 1,ZNodeRecIndex
  2977.       WasX$ = DATE$
  2978.       CALL PackDate (WasX$,ZWasY$)
  2979.       MID$(ZMsgRec$,77,2) = ZWasY$
  2980.       'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5)
  2981.       PUT 1,ZNodeRecIndex
  2982.       ZSubParm = 2
  2983.       CALL FileLock
  2984.       CLOSE 2
  2985.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF"
  2986.       OPEN "O",2,ZFileName$
  2987.       PRINT #2,MID$(ZFileName$,3,7)
  2988.       CLOSE 2
  2989.       IF ZLocalUserMode THEN _
  2990.          EXIT SUB
  2991.       IF ZSubParm <> 7 THEN _
  2992.          ZSubParm = 4 : _
  2993.          CALL FileLock : _
  2994.          CALL OpenCom(ZModemInitBaud$,",N,8,1")
  2995.       CALL TakeOffHook
  2996.       END SUB
  2997. 64003 ' $SUBTITLE: 'AskUsers - subroutine to get registration information'
  2998. ' $PAGE
  2999. '
  3000. '  NAME    --  AskUsers  (WRITTEN BY JON MARTIN)
  3001. '
  3002. '  INPUTS  --  PARAMETER                   MEANING
  3003. '              ZFileName$           NAME OF THE FILE CONTAINING THE
  3004. '                                   SCRIPT TO BE USED WHEN ASKING
  3005. '                                   THE USER QUESTIONS.
  3006. '              ZActiveUserName$     NAME OF THE CURRENT USER
  3007. '              ZUserSecLevel        USER'S SECURITY
  3008. '              ZUpperCase           SET IF USER NEEDS UPPERCASE
  3009. '
  3010. '  OUTPUTS --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
  3011. '              FILE NAME SPECIFIED AS THE First PARAMETER IN THE
  3012. '              First RECORD OF THE FILE CONTAINING THE SCRIPT TO
  3013. '              BE USED.
  3014. '              ZUserSecLevel  CAN BE RAISED OR LOWERED
  3015. '
  3016. '  PURPOSE --  Provides a sophisticated, script driven mechanism by
  3017. '              which a sysop can control the interaction with the
  3018. '              user.  Special function questionnaires include the
  3019. '              registration questionnaire and the epilog.
  3020. '
  3021.       SUB AskUsers STATIC
  3022.       ZQuestAborted = ZFalse
  3023.       ZQuestChainStarted = ZFalse
  3024.       REDIM ZOutTxt$(256)
  3025.       REDIM ZWorkAra$(ZMaxWorkVar),ZGSRAra$(ZMaxWorkVar)
  3026.       PrevAppend$ = ""
  3027. '
  3028. '
  3029. ' *  LOAD SCRIPT CONTAINING THE QUESTIONS INTO THE ZOutTxt$ DIMENSION  *
  3030. '
  3031. '
  3032. 64005 ZChatAvail = ZFalse
  3033.       QestChain = ZFalse
  3034.       LastQues = 0
  3035.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  3036.       IF NOT ZOK THEN _
  3037.          EXIT SUB
  3038.       CALL ReadParms (ZOutTxt$(),2,1)
  3039.       IF ZErrCode > 0 THEN _
  3040.          EXIT SUB
  3041.       PrevAppend$ = AppendFileName$
  3042.       AppendFileName$ = ZOutTxt$(1)
  3043.       MaxSecLevel = VAL(ZOutTxt$(2))
  3044.       WasX = INSTR(ZOutTxt$(2)," ")
  3045.       IF WasX > 0 THEN _
  3046.          IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
  3047.             CALL QuickTPut1 ("Higher security needed for questionnaire") : _
  3048.             EXIT SUB
  3049. '
  3050. '
  3051. ' *  THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
  3052. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
  3053. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
  3054. ' *   3.  THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
  3055. ' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
  3056. ' *      and requires security 5 or more to access
  3057.       ScriptIndex = 1
  3058.       ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
  3059.                          " " + _
  3060.                          DATE$ + _
  3061.                          " " + _
  3062.                          TIME$
  3063. 64010 IF EOF(2) OR ScriptIndex > 255 THEN _
  3064.          GOTO 64100
  3065.       ScriptIndex = ScriptIndex + 1
  3066.       LINE INPUT #2,ZOutTxt$(ScriptIndex)
  3067.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  3068.          CALL AllCaps (ZOutTxt$(ScriptIndex)) : _
  3069.          CALL Trim (ZOutTxt$(ScriptIndex))
  3070.       IF ZUpperCase THEN _
  3071.          CALL AllCaps (ZOutTxt$(ScriptIndex))
  3072.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "?" THEN _
  3073.          ScriptIndex = ScriptIndex + 1 : _
  3074.          ZOutTxt$(ScriptIndex) = "!"
  3075.       GOTO 64010
  3076. '
  3077. '
  3078. ' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:
  3079. ' *
  3080. ' * First COLUMN     MEANING
  3081. ' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO
  3082. ' *      !        THIS MEANS THIS IS AN ANSWER
  3083. ' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS
  3084. ' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER
  3085. ' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER
  3086. ' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA
  3087. ' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL
  3088. ' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL
  3089. ' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT
  3090. ' *      &        THIS MEANS TO CHAIN TO ANOTHER QUESTIONNAIRE
  3091. ' *      M        Execute specified macro
  3092. ' *      T        Turbo Key
  3093. ' *      <        Assign value to work variable
  3094. '
  3095. 64100 ScriptMax = ScriptIndex
  3096.       ScriptIndex = 1
  3097. 64110 CALL Carrier
  3098.       IF ZSubParm = -1 THEN _
  3099.          GOTO 64510
  3100.       ScriptIndex = ScriptIndex + 1
  3101.       IF ScriptIndex > ScriptMax THEN _
  3102.          GOTO 64400
  3103.       ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2)
  3104.       WasX = ZFalse
  3105.       IF LEFT$(ZOutTxt$,3) = "/FL" THEN _
  3106.          ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
  3107.          WasX = ZTrue
  3108.       CALL MetaGSR (ZOutTxt$,WasX)
  3109.       CALL SmartText (ZOutTxt$,ZFalse,WasX)
  3110.       WasX$ = ZOutTxt$
  3111.       ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _
  3112.          64111, _       ' catch invalid lines
  3113.          64110, _       ' : label
  3114.          64110, _       ' ! stored answer
  3115.          64420, _       ' @ abort
  3116.          64120, _       ' M macro execute
  3117.          64430, _       ' T turbo key
  3118.          64440, _       ' > goto label
  3119.          64190, _       ' < assign value
  3120.          64450, _       ' * display line
  3121.          64113, _       ' ? prompt for answer
  3122.          64114, _       ' = conditional branch
  3123.          64460, _       ' - decrease security level
  3124.          64465, _       ' + increase security level
  3125.          64470          ' & chain
  3126. 64111 ZOutTxt$ = "Invalid line.  Column 1 is <" + LEFT$(ZOutTxt$(ScriptIndex),1)+">.  Must be: * ? = + - > @ & M T <"
  3127.       ZSubParm = 5
  3128.       CALL TPut
  3129.       GOTO 64510
  3130. 64113 LastQues = ScriptIndex  ' process ?
  3131.       GOSUB 64180
  3132.       ZSubParm = 1
  3133.       CALL TGet
  3134.       IF ZSubParm = -1 THEN _
  3135.          GOTO 64510 _
  3136.       ELSE IF ZWasQ = 0 THEN _
  3137.               ZOutTxt$ = WasX$ : _
  3138.               GOTO 64113 _
  3139.            ELSE ZOutTxt$(ScriptIndex + 1) = "!" + _
  3140.                                        ZUserIn$ : _
  3141.                 ZGSRAra$(ZTestedIntValue) = ZUserIn$
  3142.       GOTO 64110
  3143. 64114 IF LEFT$(ZOutTxt$(ScriptIndex),2) = "=#" THEN _        ' Numeric
  3144.          GOSUB 64350 : _
  3145.          GOTO 64110
  3146.       GOSUB 64300             ' process =
  3147.       GOTO 64445
  3148. 64120 ZWasZ$ = MID$(ZOutTxt$(ScriptIndex),2)   ' Execute macro
  3149.       CALL Trim (ZWasZ$)
  3150.       CALL Macro (ZWasZ$,Found)
  3151.       IF Found THEN _
  3152.           CALL FDMACEXE
  3153.       GOTO 64110
  3154. 64180 CALL CheckInt (ZOutTxt$)
  3155.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  3156.           (ZTestedIntValue > ZMaxWorkVar) OR _
  3157.           (INSTR("123456789",LEFT$(ZOutTxt$,1)) = 0) THEN _
  3158.              ZTestedIntValue = 0 _
  3159.       ELSE ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-1+(ZTestedIntValue > 9))
  3160.       RETURN
  3161. 64190 GOSUB 64180
  3162.       IF ZTestedIntValue > 0 THEN _
  3163.          ZGSRAra$(ZTestedIntValue) = MID$(ZOutTxt$,2)
  3164.       GOTO 64110
  3165. '
  3166. '
  3167. ' *  SEARCH FOR GOTO LABEL
  3168. '
  3169. '
  3170. 64200 ScriptIndex = 1
  3171.       CALL MetaGSR (BranchLabel$,ZFalse)
  3172.       CALL SmartText (BranchLabel$,ZFalse,ZFalse)
  3173.       CALL AllCaps (BranchLabel$)
  3174.       CALL Trim (BranchLabel$)
  3175. 64210 ScriptIndex = ScriptIndex + 1
  3176.       IF ScriptIndex > ScriptMax THEN _
  3177.          ZOutTxt$ = BranchLabel$ + _
  3178.               " not found!" : _
  3179.          ZSubParm = 5 : _
  3180.          CALL TPut : _
  3181.          IF ZSubParm = -1 THEN _
  3182.             RETURN _
  3183.          ELSE IF LastQues > 0 THEN _
  3184.                  ScriptIndex = LastQues - 1 : _
  3185.                  RETURN _
  3186.               ELSE GOTO 64510
  3187.       IF LEFT$(ZOutTxt$(ScriptIndex),1) <> ":" THEN _
  3188.          GOTO 64210
  3189.       IF MID$(ZOutTxt$(ScriptIndex),2) <> BranchLabel$ THEN _
  3190.          GOTO 64210
  3191.       RETURN
  3192. '
  3193. '
  3194. ' *  DETERMINE BRANCH LOGIC
  3195. '
  3196. '
  3197. 64300 CurEquals = 1
  3198.       ZWasZ$ = RIGHT$(ZOutTxt$(LastQues + 1),1)
  3199.       CALL AllCaps (ZWasZ$)
  3200. 64310 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  3201.       IF NextEquals = 0 THEN _
  3202.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  3203.          GOTO 64320
  3204.       IF ZWasZ$ <> _
  3205.          MID$(ZOutTxt$(ScriptIndex),CurEquals + 1,1) THEN  _
  3206.          CurEquals = NextEquals : _
  3207.          GOTO 64310
  3208.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  3209. 64320 GOSUB 64200
  3210.       RETURN
  3211. '
  3212. '
  3213. ' *  DETERMINE Numeric BRANCH LOGIC
  3214. '
  3215. '
  3216. 64350 CurEquals = 1
  3217. 64360 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  3218.       IF NextEquals = 0 THEN _
  3219.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  3220.          GOTO 64380
  3221.       Numeric = ZTrue
  3222.       LoopIndex = 2
  3223.       WHILE LoopIndex < LEN(ZOutTxt$(ScriptIndex - 1)) +1
  3224.          IF INSTR("()1234567890- ",MID$(ZOutTxt$(ScriptIndex - 1),LoopIndex,1)) THEN _
  3225.             GOTO 64370
  3226.          Numeric = ZFalse
  3227. 64370    LoopIndex = LoopIndex + 1
  3228.       WEND
  3229.       IF NOT Numeric THEN _
  3230.          CurEquals = NextEquals : _
  3231.          GOTO 64360
  3232.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  3233. 64380 GOSUB 64200
  3234.       RETURN
  3235. '
  3236. '
  3237. ' *  WRITE RESPONSES TO DESIGNATED FILE
  3238. '
  3239. '
  3240. 64400 ScriptIndex = 0
  3241.       ZWasEN$ = AppendFileName$
  3242.       CALL LockAppend
  3243.       IF ZErrCode <> 0 THEN _
  3244.          ZOutTxt$ = "Fatal Error in script!" : _
  3245.          ZSubParm = 5 : _
  3246.          CALL TPut : _
  3247.          GOTO 64500
  3248. 64410 ScriptIndex = ScriptIndex + 1
  3249.       IF ScriptIndex > ScriptMax THEN _
  3250.          GOTO 64500
  3251.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  3252.          QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _
  3253.          GOTO 64410
  3254.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _
  3255.          LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _
  3256.          GOTO 64410
  3257.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _
  3258.          CALL PrintWorkA (QuestionSave$) : _
  3259.          CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2))
  3260.       IF ScriptIndex = 1 AND _
  3261.          AppendFileName$ <> PrevAppend$ THEN _
  3262.          CALL PrintWorkA (ZOutTxt$(ScriptIndex))
  3263.       IF ZErrCode <> 0 THEN _
  3264.          ZOutTxt$ = "Unrecoverable failure in script!" : _
  3265.          ZSubParm = 5 : _
  3266.          CALL TPut : _
  3267.          GOTO 64500
  3268.       GOTO 64410
  3269. 64420 ZQuestAborted = ZTrue  ' @ abort
  3270.       GOTO 64510
  3271. 64430 ZTurboKey = -ZTurboKeyUser   ' T turbo key
  3272.       GOTO 64110
  3273. 64440 BranchLabel$ = ZOutTxt$            ' = branch
  3274.       GOSUB 64200
  3275. 64445 IF ZSubParm = -1 THEN _
  3276.          GOTO 64510 _
  3277.       ELSE GOTO 64110
  3278. 64450 ZSubParm = 5      ' * display
  3279.       CALL TPut
  3280.       GOTO 64445
  3281. 64460 WasX = -1        ' - lower security
  3282. 64462 CALL CheckInt (ZOutTxt$)
  3283.       IF ZErrCode = 0 THEN _
  3284.          Temp = ZUserSecLevel + _
  3285.             WasX * ZTestedIntValue : _
  3286.          IF Temp <= MaxSecLevel THEN _
  3287.             ZUserSecLevel = Temp : _
  3288.             ZUserSecSave = ZUserSecLevel : _
  3289.             ZAdjustedSecurity = ZTrue
  3290.             IF ZOrigMsgFile$ = ZActiveMessageFile$ THEN _            ' KG102703
  3291.                ZOrigSec = ZUserSecLevel                              ' KG102703
  3292.       GOTO 64110
  3293. 64465 WasX = 1               ' + raise security
  3294.       GOTO 64462
  3295. 64470 QestChain = ZTrue  ' & chain questionnaires
  3296.       ZFileNameHold$ = ZOutTxt$
  3297.       GOTO 64110
  3298. 64500 CALL UnLockAppend
  3299.       CALL Carrier
  3300.       IF QestChain THEN _
  3301.          ZQuestChainStarted = ZTrue : _
  3302.          ZFileName$ = ZFileNameHold$ : _
  3303.          GOTO 64005
  3304. 64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0)
  3305.       ZOK = ZTrue
  3306.       ZLastIndex = 0
  3307.       END SUB
  3308. 64600 ' $SUBTITLE: 'ViewArc - subroutine to display .ARC contents'
  3309. ' $PAGE
  3310. '
  3311. '  NAME    --  ViewArc  (Written by Jon Martin)
  3312. '
  3313. '  INPUTS  --  PARAMETER                   MEANING
  3314. '              ZFileName$           NAME OF THE ARC FILE TO BE
  3315. '                                   VIEWED.
  3316. '
  3317. '  OUTPUTS --  NONE
  3318. '
  3319. '  PURPOSE --  Provides a mechanism to provide users with the
  3320. '              contents of a libraried file prior to downloading.
  3321. '
  3322.       SUB ViewArc STATIC
  3323.       CLOSE 2
  3324.       'IF ZTurboRBBS THEN _
  3325.          RetCode = 0
  3326.          CALL ArcV (ZArcWork$,ZFileName$,RetCode)
  3327.          CALL BufFile (ZArcWork$,WasX)
  3328.          EXIT SUB
  3329.       'IF ZShareIt THEN _
  3330.       '   OPEN ZFileName$ FOR RANDOM SHARED AS #2 LEN=1 _
  3331.       'ELSE OPEN "R",2,ZFileName$,1
  3332.       'FIELD 2,1 AS CHAR$
  3333.       'BYTE.POINTER! = 1
  3334.       'ARC.END! = LOF(2)
  3335. 64605 'IF BYTE.POINTER! > ARC.END! THEN _
  3336.       '   GOTO 64620
  3337.       'GET 2,BYTE.POINTER!
  3338.       'IF CHAR$ <> CHR$(26) THEN _
  3339.       '   GOTO 64620
  3340.       'BYTE.POINTER! = BYTE.POINTER! + 1
  3341.       'GET 2,BYTE.POINTER!
  3342.       'IF CHAR$ = CHR$(0) THEN _
  3343.       '   GOTO 64620
  3344.       'ARCED.NAME$ = ""
  3345.       'FOR WasX = 1 TO 12
  3346.       '   GET 2,BYTE.POINTER! + WasX
  3347.       '   IF CHAR$ < CHR$(40) THEN _
  3348.       '      GOTO 64610
  3349.       '   ARCED.NAME$ = ARCED.NAME$ + _
  3350.       '                 CHAR$
  3351.       'NEXT
  3352. 64610 'ZOutTxt$ = ARCED.NAME$
  3353.       'BYTE.POINTER! = BYTE.POINTER! + 14
  3354.       'GOSUB 64630
  3355.       'TOTAL.BYTES# = WORK.BYTES#
  3356.       'BYTE.POINTER! = BYTE.POINTER! + 10
  3357.       'GOSUB 64630
  3358.       'FINAL.BYTES# = WORK.BYTES#
  3359.       'ZOutTxt$ = ZOutTxt$ + _
  3360.       '     SPACE$(20 - LEN(ARCED.NAME$) - LEN(STR$(FINAL.BYTES#))) + _
  3361.       '     STR$(FINAL.BYTES#) + _
  3362.       '     " bytes."
  3363.       'CALL QuickTPut1 (ZOutTxt$)
  3364.       'BYTE.POINTER! = BYTE.POINTER! + TOTAL.BYTES# + 4
  3365.       'GOTO 64605
  3366. 64620 'CLOSE 2
  3367.       'ZSubParm = 0
  3368.       'CALL Carrier
  3369.       'ZOutTxt$ = ""
  3370.       'EXIT SUB
  3371. 64630 'FACTOR# = 1#
  3372.       'WORK.BYTES# = 0
  3373.       'FOR WasX = 0 TO 3
  3374.       '   GET 2,BYTE.POINTER! + WasX
  3375.       '   WORK.BYTES# = WORK.BYTES# + FACTOR# * ASC(CHAR$)
  3376.       '   FACTOR# = FACTOR# * 256#
  3377.       'NEXT
  3378.       'RETURN
  3379.       END SUB
  3380.